% DVIAPS DVI to APS Input Command Language translator

\def\foo{

   Textset, Inc. Confidential and Proprietary.  This work is
   protected as an unpublished work under U.S. copyright laws.
   Copyright (C) 1984 by Textset, Inc.  All rights Reserved.


 This software is furnished under a license for use only on a
 single computer system and may be copied only with the inclusion
 of the above copyright notice.  This software, or any other copies
 thereof, may not be provided or otherwise made available to any
 other person except for use on such system and to one who agrees to
 these license terms.  Title to and ownership of the software shall
 at all times remain in Textset, Inc.

 The information in this software is subject to change without notice
 and should not be construed as a commitment by Textset, Inc.

}

% Here is TeX material that gets inserted after \input webhdr
\def\hang{\hangindent 3em\indent\ignorespaces}
\font\ninerm=amr9
\let\mc=\ninerm % medium caps for names like PASCAL
\def\PASCAL{{\mc PASCAL}}

\def\(#1){} % this is used to make section names sort themselves better
\def\9#1{} % this is used for sort keys in the index

\def\title{DVIAPS}
\def\contentspagenumber{1}
\def\topofcontents{\null
  \def\titlepage{F} % include headline on the contents page
  \def\rheader{\mainfont\hfil \contentspagenumber}
  \vfill
  \centerline{\titlefont The {\ttitlefont DVIAPS} processor}
  \vskip 15pt
  \centerline{(Version 2.6, September 1984)}
  \vfill}
\def\botofcontents{\vfill
  \centerline{\hsize 5in\baselineskip9pt
    \vbox{\ninerm\noindent\foo
    `\TeX' is a trademark of the American Mathematical Society.}}}
\pageno=\contentspagenumber \advance\pageno by 1


@* Introduction.
The \.{DVIAPS} utility program reads binary device-independent (``\.{DVI}'')
files that are produced by document compilers such as \TeX, and converts them
into Autologic APS Input Command Language.  These files are suitable for
driving an Autologic APS-5 or APS-micro-5 directly.

The |banner| string defined here should be changed whenever \.{DVIAPS}
gets modified.  Also, for once and for all, we define the resolution of
the APS to be what the best inside information indicates.

@d banner=='DVIAPS Version 2.6' {printed when the program starts}
@d resolution==722.909 {|=1/0.0013833| APS pixels per inch}

@ This program is written in standard \PASCAL, except where it is necessary
to use extensions; for example, \.{DVIAPS} must read files whose names
are dynamically specified, and that would be impossible in pure \PASCAL.
All places where nonstandard constructions are used have been listed in
the index under ``system dependencies.''
@!@↑system dependencies@>

Another extension is to use a default |case| as in \.{TANGLE}, \.{WEAVE},
etc.

@d random_reading==true {should we skip around in the file?}
@d othercases == others: {default for cases not listed explicitly}
@d endcases == @+end {follows the default case in an extended |case| statement}
@f othercases == else
@f endcases == end

@ To help debug this program, there's another switch.

@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
@f debug==begin
@f gubed==end

@ There's one other switch only for use with the magic Z80 front end.
It's an experimental setup, so it's unlikely to help anyone else.

@d zilog==@{ {never change this to `$\\{zilog}\equiv\null$'}
@d goliz==@t@>@} {never change this to `$\\{goliz}\equiv\null$'}
@f zilog==begin
@f goliz==end

@ The binary input comes from |dvi_file|, and the symbolic output is
written on |APS_file| file.  Informatory messages go to the |term_out|
file. The term |print| is used instead of |write| when this program
writes on |term_out|, so that all such output could easily be
redirected if desired.

@d print(#)==write(term_out,#)
@d print_ln(#)==write_ln(term_out,#)
@d print_nl==write_ln(term_out)

@p@\
@={ Textset, Inc. Confidential and Proprietary.  This work is        }@>@/
@={ protected as an unpublished work under U.S. copyright laws.      }@>@/
@={ Copyright (c) 1984 by Textset, Inc.  All rights reserved.    }@>@/
@\
program DVI_APS(@!dvi_file,@!APS_file,@!term_in,@!term_out);
label @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var @<Globals in the outer block@>@/
@<Forward/external procedure/function declarations@>@/
procedure initialize; {this procedure gets things started properly}
  var i:integer; {loop index for initializations}
  begin
    @<Set initial values@>@/
    print_ln(banner);@/
    print_ln('Copyright (c) 1984 by Textset, Inc.  All rights reserved.');@/
  end;
@<Declare added procedures@>@/

@ Initialize the following two productions to satisfy Tangle and Weave.  These
productions are often useful in change files when adding extra procedures.

@<Forward/external procedure/function declarations@>=
  {nothing yet}

@ @<Declare added procedures@>=
  {nothing yet}

@ If the program has to stop prematurely, it goes to the
`|final_end|'. Another label, |done|, is used when stopping normally,
while |found| is used for searches.

@d final_end=9999 {label for the end of it all}
@d done=30 {go here when finished with a subtask}
@d found=31 {go here when you've found it}

@<Labels...@>=final_end;

@ The following parameters can be changed to extend or reduce
\.{DVIAPS}'s capacity.

@d file_line_length=150 {maximum number of characters input in a single
  line of input from the terminal or option file}

@<Constants...@>=
@!max_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
@!mem_max=600000; {amount of working storage for fonts and page data}
@!line_length=79; {bracketed lines of output will be at most this long}
@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
@!name_size=1000; {total length of all font file names}
@!name_length=50; {a file name shouldn't be longer than this}

@ Here are some macros for common programming idioms.

@d infinity==@'17777777777 {a very large number}
@d incr(#) == #:=#+1 {increase a variable by unity}
@d decr(#) == #:=#-1 {decrease a variable by unity}
@d do_nothing == {empty statement}

@ If the \.{DVI} file is badly malformed, the whole process must be aborted;
\.{DVIAPS} will give up, after issuing an error message about the symptoms
that were noticed.  The \.{DVI} file can be more accuratly diagnosed by the
companion program \.{DVItype}.

Such errors might be discovered inside of subroutines inside of subroutines,
so a procedure called |jump_out| has been introduced. This procedure, which
simply transfers control to the label |final_end| at the end of the program,
contains the only non-local |goto| statement in \.{DVIAPS}.
@↑system dependencies@>

@d abort(#)==begin print(' ',#); jump_out;
    end
@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
@.Bad DVI file@>

@p procedure jump_out;
begin goto final_end;
end;

@* The character set.
Like all programs written with the  \.{WEB} system, \.{DVIAPS} can be
used with any character set. But it uses ASCII code internally, because
the programming for portable input-output is easier when a fixed internal
code is used, and because \.{DVI} files use ASCII code for file names
and certain other strings.

The next few sections of \.{DVIAPS} have therefore been copied from the
analogous ones in the \.{WEB} system routines. They have been considerably
simplified, since \.{DVIAPS} need not deal with the controversial
ASCII codes less than @'40. If such codes appear in the \.{DVI} file,
they will be printed as question marks.

@<Types...@>=
@!ASCII_code=" ".."~"; {a subrange of the integers}

@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
character sets were common, so it did not make provision for lower case
letters. Nowadays, of course, we need to deal with both upper and lower case
alphabets in a convenient way, especially in a program like \.{DVIAPS}.
So we shall assume that the \PASCAL\ system being used for \.{DVIAPS}
has a character set containing at least the standard visible characters
of ASCII code (|"!"| through |"~"|).

Some \PASCAL\ compilers use the original name |char| for the data type
associated with the characters in text files, while other \PASCAL s
consider |char| to be a 64-element subrange of a larger data type that has
some other name.  In order to accommodate this difference, we shall use
the name |text_char| to stand for the data type of the characters in the
output file.  We shall also assume that |text_char| consists of
the elements |chr(first_text_char)| through |chr(last_text_char)|,
inclusive. The following definitions should be adjusted if necessary.
@↑system dependencies@>

@d text_char == char {the data type of characters in text files}
@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
@d last_text_char=127 {ordinal number of the largest element of |text_char|}

@<Types...@>=
@!text_file=packed file of text_char;

@ The \.{DVIAPS} processor converts between ASCII code and
the user's external character set by means of arrays |xord| and |xchr|
that are analogous to \PASCAL's |ord| and |chr| functions.

@<Globals...@>=
@!xord: array [text_char] of ASCII_code;
  {specifies conversion of input characters}
@!xchr: array [0..255] of text_char;
  {specifies conversion of output characters}

@ Under our assumption that the visible characters of standard ASCII are
all present, the following assignment statements initialize the
|xchr| array properly, without needing any system-dependent changes.

@<Set init...@>=
for i:=0 to @'37 do xchr[i]:='?';
xchr[@'40]:=' ';
xchr[@'41]:='!';
xchr[@'42]:='"';
xchr[@'43]:='#';
xchr[@'44]:='$';
xchr[@'45]:='%';
xchr[@'46]:='&';
xchr[@'47]:='''';@/
xchr[@'50]:='(';
xchr[@'51]:=')';
xchr[@'52]:='*';
xchr[@'53]:='+';
xchr[@'54]:=',';
xchr[@'55]:='-';
xchr[@'56]:='.';
xchr[@'57]:='/';@/
xchr[@'60]:='0';
xchr[@'61]:='1';
xchr[@'62]:='2';
xchr[@'63]:='3';
xchr[@'64]:='4';
xchr[@'65]:='5';
xchr[@'66]:='6';
xchr[@'67]:='7';@/
xchr[@'70]:='8';
xchr[@'71]:='9';
xchr[@'72]:=':';
xchr[@'73]:=';';
xchr[@'74]:='<';
xchr[@'75]:='=';
xchr[@'76]:='>';
xchr[@'77]:='?';@/
xchr[@'100]:='@@';
xchr[@'101]:='A';
xchr[@'102]:='B';
xchr[@'103]:='C';
xchr[@'104]:='D';
xchr[@'105]:='E';
xchr[@'106]:='F';
xchr[@'107]:='G';@/
xchr[@'110]:='H';
xchr[@'111]:='I';
xchr[@'112]:='J';
xchr[@'113]:='K';
xchr[@'114]:='L';
xchr[@'115]:='M';
xchr[@'116]:='N';
xchr[@'117]:='O';@/
xchr[@'120]:='P';
xchr[@'121]:='Q';
xchr[@'122]:='R';
xchr[@'123]:='S';
xchr[@'124]:='T';
xchr[@'125]:='U';
xchr[@'126]:='V';
xchr[@'127]:='W';@/
xchr[@'130]:='X';
xchr[@'131]:='Y';
xchr[@'132]:='Z';
xchr[@'133]:='[';
xchr[@'134]:='\';
xchr[@'135]:=']';
xchr[@'136]:='↑';
xchr[@'137]:='_';@/
xchr[@'140]:='`';
xchr[@'141]:='a';
xchr[@'142]:='b';
xchr[@'143]:='c';
xchr[@'144]:='d';
xchr[@'145]:='e';
xchr[@'146]:='f';
xchr[@'147]:='g';@/
xchr[@'150]:='h';
xchr[@'151]:='i';
xchr[@'152]:='j';
xchr[@'153]:='k';
xchr[@'154]:='l';
xchr[@'155]:='m';
xchr[@'156]:='n';
xchr[@'157]:='o';@/
xchr[@'160]:='p';
xchr[@'161]:='q';
xchr[@'162]:='r';
xchr[@'163]:='s';
xchr[@'164]:='t';
xchr[@'165]:='u';
xchr[@'166]:='v';
xchr[@'167]:='w';@/
xchr[@'170]:='x';
xchr[@'171]:='y';
xchr[@'172]:='z';
xchr[@'173]:='{';
xchr[@'174]:='|';
xchr[@'175]:='}';
xchr[@'176]:='~';
for i:=@'177 to 255 do xchr[i]:='?';

@ The following system-independent code makes the |xord| array contain a
suitable inverse to the information in |xchr|.

@<Set init...@>=
for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
for i:=" " to "~" do xord[xchr[i]]:=i;

@* Memory layout.
Most of the job-specific data handled by \.{DVIAPS} is kept in a single
large array called |mem|.  Data that is static during a single run of
\.{DVIAPS}, such as font information, is put at the bottom of the |mem|
array and grows upwards.  Data that is collected during the processing
of each page and can be discarded when the page is completed, such
as information about where the characters got put on a particular page,
is put at the top of the |mem| array and grows downwards.

Each element of the |mem| array can be looked at as either an integer
(at least 32 bits long) or as a group of four eight-bit bytes.  This
program makes no assumptions as to how these fields overlap.

@<Types...@>=
@!quarterword = 0..255; {1/4 of a word}
@!two_choices = 1..2; {used when there are two variants in a record}
@!four_quarters = packed record@;@/
  @!b0:quarterword;
  @!b1:quarterword;
  @!b2:quarterword;
  @!b3:quarterword;
  end;
@!memory_word = packed record@;@/
  case two_choices of
  1: (@!int:integer);
  2: (@!qqqq:four_quarters);
  end;

@ @<Types...@>=
@!mem_loc=0..mem_max;

@ Here's the |mem| array, along with the pointers to the next available
spot in low and high memory, plus some macros used to safely put things
into memory.

@d check_mem==if next_low>next_high then mem_overflow

@d low_int(#)==begin
	mem[next_low].int:=#;
	incr(next_low);
	check_mem;
	end

@d low_mem(#)==begin
	mem[next_low]:=#;
	incr(next_low);
	check_mem;
	end

@d high_int(#)==begin
	mem[next_high].int:=#;
	decr(next_high);
	check_mem;
	end

@d high_mem(#)==begin
	mem[next_high]:=#;
	decr(next_high);
	check_mem;
	end

@<Glob...@>=
@!mem: array[mem_loc] of memory_word; {the big dynamic storage area}
@!m:memory_word; {temporary memory word}
@!next_low, @!next_high: mem_loc; {next available slots in |mem|}

@ We bail out if memory isn't big enough to handle the job.

@p procedure mem_overflow;
begin
abort('Not enough memory to do the job; recompile me with more and try again');
@.Not enough memory...@>
end;

@ Obviously,

@<Set init...@>=
next_low:=0;

@ @<Wipe out temporary memory@>=
next_high:=mem_max

@ As we start to build the data structure to represent each \.{APS} page,
we reset the high memory pointer, as promised.

@<Put the starting touches on the internal page description@>=
@<Wipe out temporary memory@>;

@* Writing Autologic Input Command Language format files.
The second half of the main work of this program is handled by the procedure
|write_ICL|, which ouputs a string of \.{ICL} commands from the following
set.

@d APS_ZNOP=0 {no-op}
@d APS_NOP=255 {no-op}
@d APS_RI=238 {reset}
@d APS_SP=187 {start page}
@d APS_CF=176 {change font}
@d APS_PZ=179 {set point (vertical and horizontal) size}
@d APS_VZ=178 {set vertical size}
@d APS_HZ=177 {set horizontal size}
@d APS_VA=192 {vertical space absolute}
@d APS_HA=194 {horizontal space absolute}
@d APS_RB=225 {return beam to left margin}
@d APS_AV=213 {store vertical of rule A}
@d APS_AH=214 {store horizontal of rule A}
@d APS_XA=229 {execute rule A}
@d APS_BV=215 {store vertical of rule B}
@d APS_BH=216 {store horizontal of rule B}
@d APS_XB=231 {execute rule B}
@d APS_CM=252 {cut media}
@d APS_OA=162 {set oblique angle}
@d APS_OM=233 {oblique mode}
@d APS_NM=232 {normal mode}
@d APS_MX=201 {matrix in data stream}
@d APS_FH=138 {horizontal space 4.5pt}
@d APS_HH=130 {horizontal space 400 units}
@d APS_HQ=131 {horizontal space 200 units}
@d APS_SS=188 {self-scan display}
@d APS_EJ=254 {end of job}

@ The main output of the program goes into the |APS_file|.  It
consists of records that are |APS_length| bytes long, so it can be
written directly on a tape to be read by a standalone \.{APS} with a
tape drive.

For the magic zilog front end, there's a kind of counter that counts
many, but not all, of the bytes that get output to it.

@d APS_length=512 {Autologic documentation says it should be 1024!}

@<Glob...@>=
@!APS_file:packed file of packed array [0..APS_length-1] of eight_bits;
	{the output \.{ICL} commands go here}
@!APS_loc:integer; {current location in |APS_file|}
@!APS_count:0..APS_length-1; {next position to fill in |APS_file↑|}
@!zilog
@!many_bytes:integer;
@!copy_length:integer;
goliz

@ @<Set init...@>=
APS_loc:=0;

@ The DUMP option can be used to tell DVIAPS to print a trace of all
emitted ICL commands as it sends them out to |APS_file|.  This will be
useful mostly for debugging, but it may help us track down customer
problems too later.  Procedure |dump_ICL| prints a mneumonic dump of
ICL commands.

@<Glob...@>=
@!dump_count: integer;  {positive if dumping is activated}
@!dump_begin: integer;  {place in |APS_file| to start dumping}
@!dump_cache: array [1..3] of integer; {place to accumulate command parameters}
@!dump_pos: integer; {current position in |dump_cache|}
@!dump_len: integer; {length of current ICL command}
@!dump_adr: integer; {location in |APS_file| of current ICL instruction}

@ @<Set init...@>=
dump_count:=0;
dump_begin:=infinity;
dump_pos:=0;
dump_len:=0;

@ @p procedure dump_ICL;
var
  arg,cmd: integer;
  inches, pts: real;
begin
  if dump_len=0 then
    begin {determine the instruction length}
      case APS_byte of
        APS_SP,APS_CF,APS_PZ,APS_VZ,APS_HZ,
        APS_VA,APS_HA,APS_AV,APS_AH,APS_BV,APS_BH,
	APS_OA: dump_len:=3;
      othercases dump_len:=1;
      endcases;
      dump_adr:=APS_loc;
    end;

  incr(dump_pos);
  dump_cache[dump_pos]:=APS_byte;

  if dump_pos>=dump_len then
    begin
      cmd:=dump_cache[1];
      if dump_len>1 then
        begin
          if dump_cache[2]<128 then arg:=dump_cache[2]*256 + dump_cache[3]
          else arg:=(dump_cache[2]-256)*256 + dump_cache[3];
        end;
      inches:=arg/722.7;
      pts:=arg/10.0;
      dump_len:=0;
      dump_pos:=0;

      decr(dump_count);
      if dump_count<=0 then
        abort('Finished dumping.  Program execution terminated.');

      print(dump_adr:6,': ');
      case cmd of
        APS_ZNOP: print_ln('NOP 0/0 ');
        APS_NOP: print_ln('NOP ff/255 ');
        APS_RI:  print_ln('RI  ee/238 ');
        APS_SP:  print_ln('SP  bb/127 ',arg:7);
        APS_CF:  print_ln('CF  b0/176 ',arg:7);
        APS_PZ:  print_ln('PZ  b3/179 ',pts:7:1,'pt,',inches:7:3,'in');
        APS_VZ:  print_ln('VZ  b2/178 ',pts:7:1,'pt,',inches:7:3,'in');
        APS_HZ:  print_ln('HZ  b1/177 ',pts:7:1,'pt,',inches:7:3,'in');
        APS_VA:  print_ln('VA  c0/192 ',pts:7:1,'pt,',inches:7:3,'in');
        APS_HA:  print_ln('HA  c2/194 ',pts:7:1,'pt,',inches:7:3,'in');
        APS_RB:  print_ln('RB  e1/225 ');
        APS_AV:  print_ln('AV  d5/213 ',pts:7:1,'pt,',inches:7:3,'in');
        APS_AH:  print_ln('AH  d6/214 ',pts:7:1,'pt,',inches:7:3,'in');
        APS_XA:  print_ln('XA  e5/229 ');
        APS_BV:  print_ln('BV  d7/215 ',pts:7:1,'pt,',inches:7:3,'in');
        APS_BH:  print_ln('BH  d8/216 ',pts:7:1,'pt,',inches:7:3,'in');
        APS_XB:  print_ln('XB  e7/231 ');
        APS_CM:  print_ln('CM  fc/252 ');
        APS_OA:  print_ln('OA  a2/162 ',arg:7);
        APS_OM:  print_ln('OM  e9/233 ');
        APS_NM:  print_ln('NM  e8/232 ');
        APS_MX:  print_ln('MX  c9/201  (dumping not implemented for MX)');
        APS_FH:  print_ln('FH  8a/138 ');
        APS_HH:  print_ln('HH  82/130 ');
        APS_HQ:  print_ln('HQ  83/131 ');
        APS_SS:  print_ln('SS  bc/188 ');
        APS_EJ:  print_ln('EJ  fe/254 ');
      othercases
        begin {else just print it as a character}
          print_ln(cmd:6,' aps(',inverse_permafont[cmd],
                   '), cm(',xchr[cmd-1],')');
        end;
      endcases;
    end;
end;

@ Sending output to the |APS_file| is pretty straightforward.

@d APS_check==
        begin
	if APS_count=APS_length-1 then begin
		put(APS_file);
		APS_block;
		end
	else begin
		incr(APS_count);
		end;
        incr(APS_loc);
        end
@d APS_dump==begin
        if APS_loc>=dump_begin then dump_ICL;
        end
@d silent_APS_out(#)==begin
	APS_file↑[APS_count]:=#;
	APS_dump;
	APS_check;
	end
@d silent_APS_two(#)==begin
	two_bytes:=(#)+65536;
	silent_APS_out((two_bytes div 256) mod 256);
	silent_APS_out(two_bytes mod 256);
	end
@d APS_two(#)==begin
	two_bytes:=(#)+65536;
	APS_out((two_bytes div 256) mod 256); APS_out(two_bytes mod 256);
	end

@ Procedure |APS_out| is the one that starts a new block on the APS
output tape if necessary.

@p procedure APS_block;
	begin
	if online then APS_count:=0;
	if tape then begin
		APS_count:=4; {four byte tape block header}
                APS_loc:=APS_loc+4;
		APS_file↑[0]:=APS_length div 256;
		APS_file↑[1]:=APS_length mod 256; {|APS_length| byte blocks}
		APS_file↑[2]:=0; APS_file↑[3]:=0;
		end;
    end;

@ Procedure |APS_out| is the one that actually emits the bytes to |APS_file|.

@p procedure APS_out(byte:integer);
begin
APS_byte:=byte;
@!zilog
incr(many_bytes);
if APS_byte=223 then begin silent_APS_out(223); APS_byte:=0; end;
goliz
silent_APS_out(APS_byte);
end;

@ @<Glob...@>=
@!APS_byte: integer;
@!two_bytes:integer;

@ Let's demonstrate with some easy APS commands.  This program keeps track
of how much paper the output job will use.  The value is kept in |tot_va|,
and we know it will always be correct because the rest of this program always
uses the |APS_down| procedure for vertical motion.

@p procedure APS_down(@!downer:integer);
begin
if downer<>0 then begin
	APS_out(APS_VA);
	APS_two(downer);
	tot_va:=tot_va+downer;
	end;
end;

@ @<Set init...@>=
tot_va:=0;

@ At the end of the job, we print some job summary statistics.

@<Print job summary statistics@>=
print_nl;
print_ln('DVIAPS Job Summary:');
print_nl;
print_ln('  Pages processed: ',done_page_count:1,' DVI pages, ',
	done_cycle_count:1,' APS pages');
@#
inches:=tot_va/resolution;
feet:=inches/12.0;
meters:=inches*0.0254;
print_ln('  Job length: ',feet:1:2,' feet, ',meters:1:2,' meters');
@#
inches:=paper_width*conv/resolution;
points:=inches*72.27;
millimeters:=inches*25.4;
print_ln('  Assumed usable paper width: ',inches:1:2,'in, ',
	millimeters:1:1,'mm, ',points:1:1,'pt');
@#
inches:=gbl_max_right*conv/resolution;
points:=inches*72.27;
millimeters:=inches*25.4;
print_ln('  Maximum paper width used: ',inches:1:2,'in, ',
   millimeters:1:1,'mm, ',points:1:1,'pt');
if (total_left_dropped_chars=0) and (total_right_dropped_chars=0) then
  begin
    print_ln('  No character overruns on either side of the paper.');
  end
else
  begin
    if total_left_dropped_chars=0 then
      print_ln('  No character overruns on the left side.')
    else
      begin
        inches:=gbl_max_left*conv/resolution;
        points:=inches*72.27;
        millimeters:=inches*25.4;
        print_ln('  Total characters dropped off the left side: ',
		total_left_dropped_chars:1);
        print_ln('    - amount of overrun on the left side: ',inches:1:2,
		'in, ',millimeters:1:1,'mm, ',points:1:1,'pt');
      end;
    if total_right_dropped_chars=0 then
      print_ln('  No character overruns on the right side.')
    else
      begin
        inches:=(gbl_max_right-paper_width)*conv/resolution;
        points:=inches*72.27;
        millimeters:=inches*25.4;
        print_ln('  Total characters dropped off the right side: ',
		total_right_dropped_chars:1);
        print_ln('    - amount of overrun on the right side: ',
		inches:1:2,'in, ',millimeters:1:1,'mm, ',points:1:1,'pt');
      end;
  end;
  print_nl;

@ @<Glob...@>=
@!tot_va: integer; {total amount of vertical motion}
@!feet, @!inches, @!points, @!meters, @!millimeters: real; {other units}

@ The APS file begins simply.

@<Start up the |APS_file|@>=
rewrite(APS_file);
APS_block; {set up for first block}
@!zilog
silent_APS_out(223); silent_APS_out(1); {clear the buffer pointer}
goliz
for q:=1 to 20 do APS_out(0); {no-ops, just to start easily}
APS_out(APS_RI); {reset}
@<Make the second ID string@>;
if do_title then APS_id_out(723);
id2_string[-2]:=" "; id2_string[-1]:=" ";

@ The first ID string is meant to contain a lot of system-dependent
information, such as the input file name, the time and date of
\.{DVIAPS}ing, and the name of the user who \.{DVIAPS}ed it.  Here
is a simple example that doesn't use any special system routines.
@↑system dependencies@>

@d next1(#)==begin incr(long_id1_length); id1_string[long_id1_length]:=# end

@<Make the first ID string@>=
long_id1_length:=0;
next1("D");
next1("V");
next1("I");
next1("A");
next1("P");
next1("S");
next1(" ");
next1("O");
next1("u");
next1("t");
next1("p");
next1("u");
next1("t");
id1_length:=long_id1_length;

@ The second ID string is different for each output page.

@<Make the second ID string@>=
id2_string[-3]:="B"; id2_string[-2]:="E"; id2_string[-1]:="G";
  id2_string[0]:=" ";
long_id2_length:=id2_length+1;
id2_string[long_id2_length]:=" ";

@ Here's the last thing that happens to the |APS_file|.

@<Finish off the |APS_file|@>=
if micro then begin
APS_out(APS_SS); for q:=1 to 16 do APS_out(ord(done_message[q]));
end;
id2_string[-3]:="E"; id2_string[-2]:="N"; id2_string[-1]:="D";
long_id2_length:=id2_length;
if do_title then APS_id_out(723); {end of job identification}
APS_out(APS_EJ); {end job}
for two_bytes:=1 to APS_length do APS_out(0); {flush last buffer}
close(APS_file);

@ @<Glob...@>=
@!done_message:packed array [1..16] of char;

@ @<Set init...@>=
done_message:=' DVIAPS Job Done';

@ While we're at it, let's look at the code that leaves space around
each page, and puts in a little identification.

@<Start a new APS page@>=
APS_out(APS_SP); APS_two(count[0]); {start page}
incr(APS_page);
q:=id_integer(-3,APS_page);
long_id2_length:=id2_length+2;
id2_string[long_id2_length]:="[";
for i:=0 to start_vals do
	begin
	long_id2_length:=id_integer(long_id2_length+1,count[i]);
	if i<start_vals then begin
		incr(long_id2_length); id2_string[long_id2_length]:=".";
		end;
	end;
incr(long_id2_length); id2_string[long_id2_length]:="]";
if do_title then APS_id_out(181); {page identification}

@ @<End an APS page@>=
if not ancient_APS then APS_out(APS_CM); {cut media}

@ This procedure puts the value of the |i| parameter into |id2_string|
starting at location |loc|, and returns the next available location
in |id2_string|.

@p function id_integer(@!loc,@!i:integer):integer;
var @!tens:integer; {powers of ten}
begin
if i<0 then begin
	i:=-i;
	id2_string[loc]:="-";
	incr(loc);
	end;
tens:=10; while tens<=i do tens:=tens*10;
repeat
	tens:=tens div 10;
	id2_string[loc]:=((i div tens) mod 10) + "0";
	incr(loc);
until tens=1;
id_integer:=loc-1;
end;

@ This is the routine used to typeset a page separator slug.
This is printed at the start and end of each job, and between all pages.

@p procedure APS_id_out(@!skip:integer);
var q:integer; {pointer}
begin
APS_down(skip); {skip down the page a little}
APS_out(APS_CF); APS_two(0); {select permafont}
APS_out(APS_PZ); APS_two(100); {at 10pt}
APS_out(APS_AV); APS_two(100); APS_out(APS_AH); APS_two(240);
APS_out(APS_BV); APS_two(5); APS_out(APS_BH);
        APS_two(round(conv*paper_width)); {establish rule dimensions}
APS_out(APS_RB); APS_out(APS_XB);
APS_down(100); {skip down the page a little}
APS_out(APS_RB);
APS_out(APS_XA); {start each line with a black mark for looks}
APS_out(APS_HQ);
for q:=1 to long_id1_length do
        if id1_string[q]=" " then APS_out(APS_FH)
        else APS_out(permafont[id1_string[q]]);
APS_down(100);
APS_out(APS_RB);
APS_out(APS_XA);
APS_out(APS_HQ);
for q:=-3 to long_id2_length do
        if id2_string[q]=" " then APS_out(APS_FH)
        else APS_out(permafont[id2_string[q]]);
APS_down(50); {skip a little}
APS_out(APS_RB);
APS_out(APS_AV); APS_two(50);
APS_out(APS_XA);
APS_down(5);
APS_out(APS_RB); APS_out(APS_XB);
APS_down(skip); {skip a little}
end;

@ The |permafont| array translates from ASCII to the character set of the
one font that is guarenteed to be resident on all APS's.
The |inverse_permafont| array is used by |dump_ICL| to map APS characters
back into ASCII.

@<Glob...@>=
@!permafont: array [0..127] of eight_bits;
@!inverse_permafont: array [eight_bits] of char;
@!APS_page: integer;

@  It doesn't have a complete ASCII character set, however:

@<Set init...@>=
APS_page:=0;
for i:=0 to 127 do permafont[i]:=64; {cent-sign for unknown characters}
permafont["A"]:=1;
permafont["B"]:=2;
permafont["C"]:=3;
permafont["D"]:=4;
permafont["E"]:=5;
permafont["F"]:=6;
permafont["G"]:=7;
permafont["H"]:=8;
permafont["I"]:=9;
permafont["J"]:=10;
permafont["K"]:=11;
permafont["L"]:=12;
permafont["M"]:=13;
permafont["N"]:=14;
permafont["O"]:=15;
permafont["P"]:=16;
permafont["Q"]:=17;
permafont["R"]:=18;
permafont["S"]:=19;
permafont["T"]:=20;
permafont["U"]:=21;
permafont["V"]:=22;
permafont["W"]:=23;
permafont["X"]:=24;
permafont["Y"]:=25;
permafont["Z"]:=26;
permafont["a"]:=27;
permafont["b"]:=28;
permafont["c"]:=29;
permafont["d"]:=30;
permafont["e"]:=31;
permafont["f"]:=32;
permafont["g"]:=33;
permafont["h"]:=34;
permafont["i"]:=35;
permafont["j"]:=36;
permafont["k"]:=37;
permafont["l"]:=38;
permafont["m"]:=39;
permafont["n"]:=40;
permafont["o"]:=41;
permafont["p"]:=42;
permafont["q"]:=43;
permafont["r"]:=44;
permafont["s"]:=45;
permafont["t"]:=46;
permafont["u"]:=47;
permafont["v"]:=48;
permafont["w"]:=49;
permafont["x"]:=50;
permafont["y"]:=51;
permafont["z"]:=52;
permafont["1"]:=53;
permafont["2"]:=54;
permafont["3"]:=55;
permafont["4"]:=56;
permafont["5"]:=57;
permafont["6"]:=58;
permafont["7"]:=59;
permafont["8"]:=60;
permafont["9"]:=61;
permafont["0"]:=62;
permafont["$"]:=63;
permafont["&"]:=65;
permafont[":"]:=66;
permafont[";"]:=67;
permafont["."]:=68;
permafont[","]:=69;
permafont["`"]:=70;
permafont["'"]:=71;
permafont["?"]:=72;
permafont["!"]:=73;
permafont["%"]:=74;
permafont["*"]:=75;
permafont["("]:=76;
permafont[")"]:=77;
permafont["/"]:=78;
permafont["-"]:=79;
permafont["="]:=87;
permafont["+"]:=88;
permafont["#"]:=89;
@#
{cheat a little for characters we'd really like to see}
permafont["{"]:=76;
permafont["}"]:=77;
permafont["["]:=76;
permafont["]"]:=77;
permafont["<"]:=76;
permafont[">"]:=77;
@#
for i:=0 to 255 do inverse_permafont[i]:='?';
for i:=0 to 127 do
  if permafont[i]<>64 then inverse_permafont[permafont[i]]:=xchr[i];

@ We often want to check that the \.{APS} knows a certain value, and
if not, tell it about it.  The |perhaps| procedure check the |is|
variable, and if it is not the same as |should_be|, then it sets it to
what it |should_be|, and sends the \.{APS} the |APS_cmd| followed by a
two-byte parameter, so that it knows what it |should_be|, too.

@p procedure perhaps(@!APS_cmd,@!should_be:integer; var is:integer);
begin
if is<>should_be then begin
	is:=should_be;
	APS_out(APS_cmd); APS_two(should_be);
	end;
end;

@ The routines that actually make use of all this occur later.

@p
@<Procedures for writing ICL files@>

@* Reading the AMF file availability list.
A single font may have been digitized in a few different master sizes,
and this program must know what magnifications are available for each
font.  This information is kept in the file |AMF_list|, each line of
which has a font name and one or more magnifications separated by
spaces.  The list must be in alphabetical order by font name.

@p procedure read_availability;
var j,@!k:integer; {temporary}
ch:ASCII_code;
AMF_line: integer; {current line number}
begin
reset(AMF_list,'APSfonts:AMF.LST');
@.APSfonts@>
@.AMF.LST@>
AMF_line:=0;
@<Wipe out temporary memory@>;
while not eof(AMF_list) do begin
	incr(AMF_line);
	@<Process an |AMF_list| line@>;
	end;
@<Finish the |AMF_list| processing@>;
end;

@ The font name eventually ends up in low memory, with the first byte
giving the name length.  Following the name are full word integers
listing the available magnifications, terminated with a zero.  In high
memory we temporarily leave a pointer to the beginning of the font
name.

A little definition helps ease references to the next input character.

@d next_AMF_list==xord[AMF_list↑]

@<Process an |AMF_list| line@>=
@<Skip spaces in an |AMF_list| item@>;
if next_AMF_list<>"%" then begin
	@<Do the name from an |AMF_list| item@>;
	@<Skip spaces in an |AMF_list| item@>;
	while not eoln(AMF_list) do begin
		@<Read an integer from |AMF_list| into |k|@>;
		low_int(k);
		@<Skip spaces in an |AMF_list| item@>;
		end;
	low_int(0);
	end;
read_ln(AMF_list);

@ @<Skip spaces in an |AMF_list| item@>=
while (not eoln(AMF_list)) and (next_AMF_list=" ") do get(AMF_list);

@ We have to go through a little mess to put the name in the right place.

We'll need to define macro |lowere_case| to help out with case conversion.

@d lower_case(#)==if (#>"A") and (#<"Z") then #:=#+"a"-"A"

@<Do the name from an |AMF_list| item@>=
j:=next_low; {points to start of name}
k:=0;
ch:=next_AMF_list;
lower_case(ch);
while ch<>" " do begin
	incr(k);
	case k mod 4 of
		0: begin low_mem(m); m.qqqq.b0:=ch; end;
		1: m.qqqq.b1:=ch;
		2: m.qqqq.b2:=ch;
		3: m.qqqq.b3:=ch;
		end;
	get(AMF_list);
        ch:=next_AMF_list;
        lower_case(ch);
	end;
low_mem(m); {remember to save final (partial) word}
mem[j].qqqq.b0:=k; {fill in the length field}
high_int(j); {a pointer to the name}

@ @<Read an integer from |AMF_list| into |k|@>=
k:=0;
j:=next_AMF_list;
while (j>="0") and (j<="9") and (k<@'77777777) do begin
	k:=10*k+j-"0";
	get(AMF_list);
	j:=next_AMF_list;
	end;
if j<>" " then abort('Bad AMF.LST file format in line ',AMF_line:1);
@.Bad AMF.LST file...@>

@ Now we can copy the list of pointers down to permanent low memory,
and leave a global pointer to them in |AMF_begin| and |AMF_end|.

@<Finish the |AMF_list| processing@>=
@!debug
print_ln(' Finished reading AMF.LST: ',AMF_line:1,' lines.');
gubed@/
AMF_begin:=next_low;
k:=mem_max;
while k>next_high do begin
	low_mem(mem[k]);
	decr(k);
	end;
AMF_end:=next_low-1;

@ @<Glob...@>=
@!AMF_begin, @!AMF_end: mem_loc; {delimit list of pointers to available fonts}
@!AMF_list: text_file; {the font availability file}

@ Here's a little routine that compares a font name in |fnam| with
one in the list we just constructed.  It returns zero if they are the
same, |-1| if |fnam| is alphabetically lower, and |+1| if it's higher.

@p function fnam_compare(@!AMF_name_ptr:integer):integer;
label done;
var k:mem_loc; @!c,@!ch:ASCII_code; @!j,@!len:integer;
begin
k:=AMF_name_ptr; m:=mem[k];
len:=m.qqqq.b0;
if fnam_len<len then begin fnam_compare:=-1; len:=fnam_len; end
else if fnam_len>len then fnam_compare:=+1
else fnam_compare:=0;
for j:=1 to len do begin
	case j mod 4 of
		0: begin incr(k); m:=mem[k];
		   c:=m.qqqq.b0; end;
		1: c:=m.qqqq.b1;
		2: c:=m.qqqq.b2;
		3: c:=m.qqqq.b3;
		end;
        ch:=fnam[j]; lower_case(ch);
	if ch<c then begin fnam_compare:=-1; goto done; end;
	if ch>c then begin fnam_compare:=+1; goto done; end;
	end;
done:
end;

@ It is, of course, a simple matter to print the name of a given font.

@p procedure print_font(@!f:integer); {|f| is an internal font number}
var k:0..name_size; {index into |names|}
begin
  if f=nf then print('undefined!')
  else
    begin
      for k:=font_name[f] to font_name[f+1]-1 do print(xchr[names[k]]);
    end;
end;

@ @<Glob...@>=
@!fnam: packed array [1..name_length] of ASCII_code; {internal font name}
@!fnam_len: 0..name_length; {number of significant characters in |fnam|}
@!font_name:array [0..max_fonts] of 0..name_size;
   {starting positions of external font names}
@!names:array [0..name_size] of ASCII_code; {characters of names}

@ @<Set init...@>=
font_name[0]:=0;

@* Input from binary files.
Both \.{DVI} and \.{AMF} files are sequences of 8-bit bytes. The bytes
appear physically in what is called a `|packed file of 0..255|'
in \PASCAL\ lingo.

Packing is system dependent, and many \PASCAL\ systems fail to implement
such files in a sensible way (at least, from the viewpoint of producing
good production software).  For example, some systems treat all
byte-oriented files as text, looking for end-of-line marks and such
things. Therefore some system-dependent code is often needed to deal with
binary files, even though most of the program in this section of
\.{DVIAPS} is written in standard \PASCAL.
@↑system dependencies@>

One common way to solve the problem is to consider files of |integer|
numbers, and to convert an integer in the range $-2↑{31}\L x<2↑{31}$ to
a sequence of four bytes $(a,b,c,d)$ using the following code, which
avoids the controversial integer division of negative numbers:
$$\vbox{\halign{#\hfil\cr
|if x>=0 then a:=x div @'100000000|\cr
|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
\quad|end|\cr
|x:=x mod @'100000000;|\cr
|b:=x div @'200000; x:=x mod @'200000;|\cr
|c:=x div @'400; d:=x mod @'400;|\cr}}$$
The four bytes are then kept in a buffer and output one by one. (On 36-bit
computers, an additional division by 16 is necessary at the beginning.
Another way to separate an integer into four bytes is to use/abuse
\PASCAL's variant records, storing an integer and retrieving bytes that are
packed in the same place; {\sl caveat implementor!\/}) It is also desirable
in some cases to read a hundred or so integers at a time, maintaining a
larger buffer.

We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
even if such simplicity is sometimes unrealistic.

@<Types...@>=
@!eight_bits=0..255; {unsigned one-byte quantity}
@!byte_file=packed file of eight_bits; {files that contain binary data}

@ The program deals with two binary file variables: |dvi_file| is the main
input file that we are translating into \.{ICL} form, and |AMF_file| is
the current font information file from which character data is
being read.

@<Glob...@>=
@!dvi_file:byte_file; {the stuff we are \.{DVIAPS}ing}
@!AMF_file:byte_file; {font information files}

@ To prepare these files for input, we |reset| them. An extension of
\PASCAL\ is needed in the case of |AMF_file|, since we want to associate
it with external files whose names are specified dynamically (i.e., not
known at compile time). The following code assumes that `|reset(f,s)|'
does this, when |f| is a file variable and |s| is a string variable that
specifies the file name. If |eof(f)| is true immediately after
|reset(f,s)| has acted, we assume that no file named |s| is accessible.
@↑system dependencies@>

@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
begin reset(dvi_file);
cur_loc:=0;
end;
@#
function open_AMF_file:boolean; {prepares to read packed bytes in |AMF_file|}
begin reset(AMF_file,cur_name);
open_AMF_file:=not eof(AMF_file);
end;

@ If you looked carefully at the preceding code, you probably asked,
``What are |cur_loc| and |cur_name|?'' Good question. They're global
variables: |cur_loc| is the number of the byte about to be read next from
|dvi_file|, and |cur_name| is a string variable that will be set to the
current APS font file name before |open_AMF_file| is called.

@<Glob...@>=
@!cur_loc:integer; {where we are about to look, in |dvi_file|}
@!cur_name:packed array[1..name_length] of char; {external name}

@ It's a simple matter to print out |cur_name|.
@p procedure print_cur_name;
var k:1..name_length;
begin
for k:=1 to name_length do print(cur_name[k]);
end;

@ We shall use a set of simple functions to read the next byte or
bytes from |dvi_file|. There are seven possibilities, each of which is
treated as a separate function in order to minimize the overhead for
subroutine calls.
@↑system dependencies@>

@p function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(dvi_file) then get_byte:=0
else  begin read(dvi_file,b); incr(cur_loc); get_byte:=b;
  end;
end;
@#
function signed_byte:integer; {returns the next byte, signed}
var b:eight_bits;
begin read(dvi_file,b); incr(cur_loc);
if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
end;
@#
function get_two_bytes:integer; {returns the next two bytes, unsigned}
var a,@!b:eight_bits;
begin read(dvi_file,a); read(dvi_file,b);
cur_loc:=cur_loc+2;
get_two_bytes:=a*256+b;
end;
@#
function signed_pair:integer; {returns the next two bytes, signed}
var a,@!b:eight_bits;
begin read(dvi_file,a); read(dvi_file,b);
cur_loc:=cur_loc+2;
if a<128 then signed_pair:=a*256+b
else signed_pair:=(a-256)*256+b;
end;
@#
function get_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:eight_bits;
begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
cur_loc:=cur_loc+3;
get_three_bytes:=(a*256+b)*256+c;
end;
@#
function signed_trio:integer; {returns the next three bytes, signed}
var a,@!b,@!c:eight_bits;
begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
cur_loc:=cur_loc+3;
if a<128 then signed_trio:=(a*256+b)*256+c
else signed_trio:=((a-256)*256+b)*256+c;
end;
@#
function signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:eight_bits;
begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
cur_loc:=cur_loc+4;
if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
end;

@ Finally we come to the routines that are used only if |random_reading| is
|true|. The driver program below needs two such routines: |dvi_length| should
compute the total number of bytes in |dvi_file|, possibly also
causing |eof(dvi_file)| to be true; and |move_to_byte(n)|
should position |dvi_file| so that the next |get_byte| will read byte |n|,
starting with |n=0| for the first byte in the file.
@↑system dependencies@>

Such routines are, of course, highly system dependent. They are implemented
here in terms of two assumed system routines called |set_pos| and |cur_pos|.
The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
negative or larger than the total number of items in |f|; in the latter
case, |set_pos(f,n)| moves to the end of file |f|.
The call |cur_pos(f)| gives the total number of items in |f|, if
|eof(f)| is true; we use |cur_pos| only in such a situation.

@p function dvi_length:integer;
begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
end;
@#
procedure move_to_byte(n:integer);
begin set_pos(dvi_file,n); cur_loc:=n;
end;

@ The other kind of file that \.{DVIAPS} reads is the \.{APS Matrix
Font} or \.{AMF} file.  Although they are read as binary bytes, they
are always a multiple of four bytes long.  Here's a routine that reads
the next four bytes of an \.{AMF} file and puts them into the next available
spot in low memory.
@.AMF {\rm files}@>
@↑system dependencies@>

@d AMF_word==
	begin
	m.qqqq.b0:=AMF_file↑; get(AMF_file);
	m.qqqq.b1:=AMF_file↑; get(AMF_file);
	m.qqqq.b2:=AMF_file↑; get(AMF_file);
	m.qqqq.b3:=AMF_file↑; get(AMF_file);
	low_mem(m);
	end

@ Data from the \.{AMF} file is read in as bytes, but some groups of
four bytes are meant to be looked at as 32-bit integers.  These
routines convert a |mem| word from four individual bytes into a 32-bit
integer.  The first, |pintegerize|, does nothing else, while the other,
|fintegerize|, also returns the integer value computed.  Note that on
some machines, |pintegerize| can be turned into a |do_nothing|, and on
some others it can simply rearrange the bytes, but of course using
such dirty \PASCAL\ is highly system-dependent.
@↑Dirty Pascal@>
@↑system dependencies@>

@p procedure pintegerize(@!loc:mem_loc);
begin
m:=mem[loc];
if m.qqqq.b0<128 then
  mem[loc].int:=((m.qqqq.b0*256+m.qqqq.b1)*256+m.qqqq.b2)*256+m.qqqq.b3
else
  mem[loc].int:=(((m.qqqq.b0-256)*256+m.qqqq.b1)*256+m.qqqq.b2)*256+m.qqqq.b3;
end;
@#
function fintegerize(@!loc:mem_loc):integer;
begin
m:=mem[loc];
if m.qqqq.b0<128 then
  mem[loc].int:=((m.qqqq.b0*256+m.qqqq.b1)*256+m.qqqq.b2)*256+m.qqqq.b3
else
  mem[loc].int:=(((m.qqqq.b0-256)*256+m.qqqq.b1)*256+m.qqqq.b2)*256+m.qqqq.b3;
fintegerize:=mem[loc].int;
end;

@* Reading the font information.
This program needs to know quite a bit about the fonts requested by
the \.{DVI} file (including character widths).  \.{DVIAPS} looks at
the APS Matrix Files (\.{AMF}) for the fonts that are involved.
This information gets put into the |mem| array for future reference.

The macros presented here are used to get at the font information
loaded from \.{AMF} files into the |mem| array.  Since they are loaded
pretty much word-for-word, the macros mimic the format of \.{AMF}
files on disk.  (A complete description of \.{AMF} file format appears
in the documentation of \.{AMFtype} and will not be repeated here.)

The current number of known fonts is |nf|. Each known font has an
internal number |f|, where |0<=f<nf|; the external number of this
font, i.e., its font identification number in the \.{DVI} file, is
|font_num[f]|.  The beginning of its \.{AMF} information in the |mem|
array is pointed to by |font_info[f]|.  Many of the values of the
current font's fields are copied into global variables for quick
reference.

@d segtype_long == 0 {type for 16-word character entries}
@d segtype_short == 1 {type for 3-word character entries}
@#
@d sg_type(#) == (# div @'100000000)
@d sg_ptr(#) == (# mod @'100000000)
@d sg_font(#) == (# div @'100000000) {used in |xxx_APS_info|}
@d sg_char(#) == (# mod @'100000000) {used in |xxx_APS_info|}
@#
@d loc_bc(#)==(font_info[#]+0)
@d loc_ec(#)==(font_info[#]+1)
@d loc_check_sum(#)==(font_info[#]+2)
@d loc_scaled_size(#)==(font_info[#]+3)
@d loc_design_size(#)==(font_info[#]+4)
@d loc_directory_ptr(#)==(font_info[#]+5)
@d loc_AMF_id(#)==(font_info[#]+6)
@d loc_font_dir_base(#)==loc_AMF_id(#) {overlap with unused |AMF_id|}
@d loc_font_width_base(#)==(font_info[#]+7)
@d loc_char_defaults_base(#)==(font_info[#]+8)
@d loc_next_font(#)==(font_info[#]+9)
@#
@d font_bc(#)==mem[loc_bc(#)].int
@d font_ec(#)==mem[loc_ec(#)].int
@d font_check_sum(#)==mem[loc_check_sum(#)].int
@d font_magnification(#)==mem[loc_scaled_size(#)].int
@d font_design_size(#)==mem[loc_design_size(#)].int
@d font_directory_ptr(#)==mem[loc_directory_ptr(#)].int
@d font_AMF_id(#)==mem[loc_AMF_id(#)].int
@d font_dir_base(#)==mem[loc_font_dir_base(#)].int
@d font_width_base(#)==mem[loc_font_width_base(#)].int
@#
@d char_defaults_base(#)==mem[loc_char_defaults_base(#)].int
@#
@d loc_next_sg==cur_sg
@d loc_pixel_width==(1+cur_sg)
@d loc_box_height==(2+cur_sg)
@d loc_box_width==(3+cur_sg)
@d loc_x_offset==(4+cur_sg)
@d loc_y_offset==(5+cur_sg)
@d loc_x_magnification==(6+cur_sg)
@d loc_y_magnification==(7+cur_sg)
@d loc_APS_font==(8+cur_sg)
@d loc_APS_char==(9+cur_sg)
@d loc_APS_slant==(10+cur_sg)
@d loc_APS_bits==(11+cur_sg)
@d loc_data_ptr==(12+cur_sg)
@d loc_data_length==(13+cur_sg)
@d loc_word_1==(14+cur_sg)
@d loc_word_2==(15+cur_sg)
@#
@d shrt_loc_pixel_width==(0+cur_sg) {for short segments}
@d shrt_loc_APS_info==(1+cur_sg) {for short segments}
@#
@d sg_next_sg==mem[loc_next_sg].int
@d sg_pixel_width==mem[loc_pixel_width].int
@d sg_box_height==mem[loc_box_height].int
@d sg_box_width==mem[loc_box_width].int
@d sg_x_offset==mem[loc_x_offset].int
@d sg_y_offset==mem[loc_y_offset].int
@d sg_x_magnification==mem[loc_x_magnification].int
@d sg_y_magnification==mem[loc_y_magnification].int
@d sg_APS_font==mem[loc_APS_font].int
@d sg_APS_char==mem[loc_APS_char].int
@d sg_APS_slant==mem[loc_APS_slant].int
@d sg_APS_bits==mem[loc_APS_bits].int
@d sg_data_ptr==mem[loc_data_ptr].int
@d sg_data_length==mem[loc_data_length].int
@d sg_word_1==mem[loc_word_1].int
@d sg_word_2==mem[loc_word_2].int
@#
@d shrt_sg_pixel_width==mem[shrt_loc_pixel_width].int {for short segments}
@d shrt_sg_APS_info==mem[shrt_loc_APS_info].int {for short segments}
@#
@d loc_char_sg_ptr(#)==(cur_dir_base+#)
@d char_sg_ptr(#)==mem[loc_char_sg_ptr(#)].int
@d loc_char_width_base(#)==(cur_width_base+#)
@d char_width(#)==mem[loc_char_width_base(#)].int
@d invalid_width==@'17777777777

@<Glob...@>=
@!nf:0..max_fonts; {the number of known fonts}
@!font_info:array [0..max_fonts] of integer; {font information offset}
@!font_num:array [0..max_fonts] of integer; {external font numbers}
@!cur_sg:integer; {current character segment}
@!cur_sg_type:integer; {current character segment type}
@!orig_sg:integer; {used for processing short character segments}
@!prev_sg:integer; {used to remember the previous character segment}
@!next_sg:integer; {used while cycling through character segments}
@#
@!cur_font:integer; {current internal font number}
@!cur_info:integer; {|font_info[cur_font]|}
@!cur_dir_base:integer; {|font_dir_base(cur_font)|}
@!cur_width_base:integer; {|font_width_base(cur_font)|}
@!cur_bc, @!cur_ec: integer; {|font_bc(cur_font)|, |font_ec(cur_font)|}
@!cur_x_mag:integer; {current font magnification}
@!cur_pixel_width:integer; {current pixel width}
@!cur_APS_char:integer; {current APS characxter}
@!cur_APS_font_index:integer; {current APS font index}

@ @<Set init...@>=
nf:=0;

@ Here is a procedure that absorbs the necessary information from an
\.{AMF} file, assuming that the file has just been successfully reset
so that we are ready to read its first word.

There is a parameter, |z|, which represents the scaling factor being
used to compute the font dimensions; it must be in the range $0<z<2↑{27}$.

@p function in_AMF(@!z:integer):boolean;
	{input \.{AMF} data or return |false|}
label 9997, {go here when the format is bad}
  9999;  {go here to exit}
var k:integer; {index for loops}
@!AMF_start:integer; {start of \.{AMF} data in |mem| array}
@!magic_offset:integer; {adjustment for location in |mem|}
@!alpha,@!beta:integer; {quantities used in the scaling computation}
@!real_x_mag: real; {infinite precision set width}
@!def_sg_x_mag: integer; {used in setting |sg_pixel_width| for short segments}
@!def_real_x_mag: real; {used in setting |sg_pixel_width| for short segments}
begin
@<Check that this is an \.{AMF} file, and skip the uninteresting header@>;
@<Read the whole \.{AMF} file, |goto 9997| if there is a problem@>;
@<Adjust the font data@>;
@<Convert the width values@>;
in_AMF:=true; goto 9999;
9997: in_AMF:=false;
9999: end;

@ A few temporaries are needed to help.

@<Glob...@>=
@!adjusted_width:integer; {for adjusting width values}
@!font_multiplier:real; {unmagnified |at_size/design_size|}

@ The first word of an \.{AMF} file has the value @"AF to identify it
as such.  The next |AMF_header_length| words contain header
information that is not needed by \.{DVIAPS} and is skipped over.  The
input may, of course, be all screwed up and not a \.{AMF} file at all.
So we begin cautiously.

@d AMF_header_length=1 {BUG FIXME when there's more info in the header}

@d bad_AMF(#)==begin print(#,': '); print_cur_name;
  goto 9997;
  end

@<Check that this is an \.{AMF} file, and skip the uninteresting header@>=
AMF_word;
if fintegerize(next_low-1)<>@"AF then
	bad_AMF('Bad AMF file beginning',mem[next_low-1].int:1);
@.Bad AMF file beginning...@>
for k:=2 to AMF_header_length do AMF_word;
next_low:=next_low-AMF_header_length; {forget header}

@ Here we read the better part of the \.{AMF} file into the |mem|
array, keeping track of where it begins and ends.  We then leave a
pointer to the seven special words at the end of the file in
|font_info[nf]|, and calculate the |magic_offset| by which all the
pointers need to be adjusted to account for the fact that the \.{AMF}
data starts in location |AMF_start| in the |mem| array.

@<Read the whole \.{AMF} file...@>=
AMF_start:=next_low;
while not eof(AMF_file) do AMF_word;
decr(next_low); {we'll forget the final ID word}
if fintegerize(next_low)<>@"AF
	then bad_AMF('Bad AMF file ending (',mem[next_low].int:1,')');
@.Bad AMF file ending...@>
font_info[nf]:=next_low-6;
next_low:=loc_next_font(nf); {leave room for the extra font data}
check_mem; {was there room for it?}
magic_offset:=AMF_start-AMF_header_length; {adjustment for |mem| location}

@ We have to |pintegerize| all of the 32-bit integers and chase down
all the pointers that are relative to the beginning of the \.{AMF}
file to change them to be relative to the beginning of |mem|.

@<Adjust the font data@>=
@<Adjust the global font data@>;
@#
{Process the default values, for character -1, first}
k:=font_bc(nf)-1; @<Adjust character |k|'s data@>; {adjust default settings}
char_defaults_base(nf):=mem[font_directory_ptr(nf)-1].int;
def_sg_x_mag:=sg_x_magnification;
def_real_x_mag:=real_x_mag;
@#
{Now process the rest of the characters}
for k:=font_bc(nf) to font_ec(nf) do @<Adjust character |k|'s data@>;

@ We have to |pintegerize| the global font data, and fix the various
pointers to point to the right place in |mem|.

@<Adjust the global font data@>=
pintegerize(loc_bc(nf)); pintegerize(loc_ec(nf));
pintegerize(loc_check_sum(nf));
pintegerize(loc_scaled_size(nf)); pintegerize(loc_design_size(nf));
pintegerize(loc_directory_ptr(nf));
font_directory_ptr(nf):=font_directory_ptr(nf)+magic_offset;
font_dir_base(nf):=font_directory_ptr(nf)-font_bc(nf);
font_width_base(nf):=font_dir_base(nf)+font_ec(nf)-font_bc(nf)+1;

@ Some of the character segment entries are abbreviated to save space
in the \.{AMF} files.  An abbreviated character segment is tagged by
setting the high orger byte of the pointer to the character segment's
entry in the font directory vector at the end of the \.{AMF} file. The
high order byte can be set to either |segtype_long| or |segtype_short|
to indicate how the segment is organized.
Long segments consist of 16 words.  Short segments consist of just two
words---the |sg_pixel_width| and the |sg_APS_char|.  Multiple segment
characters must all have complete long entries since the character
segment data references assume that layout.  For short segments, the data
has to be expanded out to full size when the character is referenced.
This is done by overlaying the only two words that vary on top of
the default value character segment.

Here we take advantage of the fact that |loc_next_sg=sg_ptr(cur_sg)| to
use a small trick to step through the linked list of character parts.

@<Adjust character |k|'s data@>=
begin
cur_sg:=font_dir_base(nf)+k;
next_sg:=fintegerize(loc_next_sg);
while next_sg<>0 do begin
	sg_next_sg:=sg_next_sg+magic_offset;
	if (sg_ptr(sg_next_sg)>next_low) or (sg_ptr(sg_next_sg)<AMF_start)
		then bad_AMF('Bad segment pointer');
		@.Bad segment pointer@>
        cur_sg_type:=sg_type(sg_next_sg);
        cur_sg:=sg_ptr(sg_next_sg);
        if cur_sg_type=segtype_long then
            begin
		@<Adjust a long character segment's data@>;
		next_sg:=fintegerize(loc_next_sg);
            end
        else
            begin
		@<Adjust a short character segment's data@>;
		next_sg:=0; {short segments can't be continued}
            end;
	end;
end

@ Most of the work here is mundane: we convert the
|sg_x_magnification| and |sg_y_magnification| to \.{APS} units, while
|sg_x_offset| and |sg_y_offset| are changed into \.{DVI} units.  The
other elements of the record are checked for consistancy.  There is
some subtlety in the calculation to convert |sg_pixel_width| to
\.{DVI} units, due to the fact that we have limited accuracy in
telling the APS what the font set-width is.

@<Adjust a long character segment's data@>=
begin
sg_y_offset:=round(fintegerize(loc_y_offset)*font_multiplier);
sg_x_offset:=round(fintegerize(loc_x_offset)*font_multiplier);
sg_y_magnification:=round(fintegerize(loc_y_magnification)*
	conv*font_multiplier);
real_x_mag:=fintegerize(loc_x_magnification)*conv*font_multiplier;
sg_x_magnification:=round(real_x_mag);
sg_pixel_width:=round(fintegerize(loc_pixel_width)*(font_multiplier*
		sg_x_magnification/real_x_mag));
pintegerize(loc_APS_font);
pintegerize(loc_APS_char);
pintegerize(loc_APS_slant);
pintegerize(loc_APS_bits);
if fintegerize(loc_data_ptr)<>0 then begin
	sg_data_ptr:=(sg_data_ptr div 4)+magic_offset; {change to word pointer}
	if (sg_data_ptr>next_low) or (sg_data_ptr<AMF_start)
		then bad_AMF('Bad data pointer');
@.Bad data pointer@>
	end;
pintegerize(loc_data_length); {BUG FIXME check bounds}
if odd(sg_data_length) then bad_AMF('Bad data length');
@.Bad data length@>
if abs(fintegerize(loc_word_1))+abs(fintegerize(loc_word_2))>0
	then bad_AMF('Bad segment word (non-zero)');
@.Bad segment word@>
end

@ In the case of a short entry, we must still |integerize| the data. The same
types of things as above must be done, except that the short entries are
organized differently.  They consist only of the |shrt_sg_pixel_width| field
and the |shrt_sg_APS_info| field.  The |shrt_sg_APS_info| field consists
of the current font number in the high order byte and the APS character
number in the low order three bytes.

\indent |def_sg_x_mag| and |def_real_x_mag|, used in calculating
|shrt_sg_pixel_width| were calculated earlier when the default
settings were being processed.

@<Adjust a short character segment's data@>=
begin
shrt_sg_pixel_width:=
	round(fintegerize(shrt_loc_pixel_width)*
		(font_multiplier*def_sg_x_mag/def_real_x_mag));
shrt_sg_APS_info:=fintegerize(shrt_loc_APS_info) + nf*@'100000000;
end

@ The most important part of |in_AMF| is the width computation, which
involves multiplying the relative widths in the \.{AMF} file by the
scaling factor in the \.{DVI} file. This fixed-point multiplication
must be done with precisely the same accuracy by all \.{DVI}-reading
programs, in order to validate the assumptions made by \.{DVI}-writing
programs like \TeX82.

Let us therefore summarize what needs to be done. Each width in a \.{AMF}
file appears as a four-byte quantity called a |fix_word|.  A |fix_word|
whose respective bytes are $(a,b,c,d)$ represents the number
$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
b\cdot2↑{-4}+c\cdot2↑{-12}+d\cdot2↑{-20}&a=0;\cr
-16+b\cdot2↑{-4}+c\cdot2↑{-12}+d\cdot2↑{-20}&a=255.\cr}}\right.$$
(No other choices of $a$ are allowed, since the magnitude of an \.{AMF}
dimension must be less than 16.)  We want to multiply this quantity by the
integer~|z|, which is known to be less than $2↑{27}$. Let $\alpha=16z$.
If $|z|<2↑{23}$, the individual multiplications $b\cdot z$, $c\cdot z$,
$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or
16, to obtain a multiplier less than $2↑{23}$, and we can compensate for
this later. If |z| has thereby been replaced by $|z|↑\prime=|z|/2↑e$, let
$\beta=2↑{4-e}$; we shall compute
$$\lfloor(b+c\cdot2↑{-8}+d\cdot2↑{-16})\,z↑\prime/\beta\rfloor$$ if $a=0$,
or the same quantity minus $\alpha$ if $a=255$.  This calculation must be
done exactly, for the reasons stated above; the following program does the
job in a system-independent way, assuming that arithmetic is exact on
numbers less than $2↑{31}$ in magnitude.

If a character doesn't exist in the font, then it will have |a=128|
(contrary to what is said above) which we adjust to |invalid_width|.

@<Convert the width values...@>=
@<Replace |z| by $|z|↑\prime$ and compute $\alpha,\beta$@>;
for k:=font_width_base(nf)+font_bc(nf) to font_width_base(nf)+font_ec(nf) do
  begin
  m:=mem[k];
  if m.qqqq.b0<>128 then
    begin
    adjusted_width:=
	(((((m.qqqq.b3*z)div@'400)+(m.qqqq.b2*z))div@'400)+
		(m.qqqq.b1*z))div beta;
    if m.qqqq.b0>0 then if m.qqqq.b0<255 then
	bad_AMF('Illegal character width in AMF file')
@.Illegal character width...@>
    else adjusted_width:=adjusted_width-alpha;
    end
  else adjusted_width:=invalid_width;
  mem[k].int:=adjusted_width;
  end

@ @<Replace |z|...@>=
begin alpha:=16*z; beta:=16;
while z>=@'40000000 do
  begin z:=z div 2; beta:=beta div 2;
  end;
end

@* User specified options.
The \.{DVIAPS} user is able to specify a number of run-time options
from the terminal or from a file.  These options include the ability
to override the magnification factor that is stated in the \.{DVI}
file; to limit the number of pages processed by \.{DVIAPS}; to ask for
specific pages to be processed while others are skipped over.

When \.{DVIAPS} begins, it engages the user in a brief dialog so that the
options will be specified. This part of \.{DVIAPS} requires nonstandard
\PASCAL\ constructions to handle the online interaction.
@↑system dependencies@>

@<Glob...@>=
@!max_pages:integer; {at most this many |bop..eop| pages will be printed}
@!use_mag:integer; {user specified magnification}
@!min_top_space:integer; {minimum white space allowed at top of page}
@!max_top_space:integer; {maximum white space allowed at top of page}
@!bot_space:integer; {minumum net page depth}
@!paper_width:integer; {maximum horizontal coordinate allowed}
@!do_title:boolean; {print the title on each page?}
@!micro, @!macro, @!online, @!tape: boolean; {type of hardware}
@!ancient_APS: boolean; {flag for ancient APS-5 usage}
@!APS_70_pica: boolean; {flag for usage of 70-pica APS-5 models}
@!extra_magnification_allowed: boolean;
	{true if extra magnification allowed beyond nominal range size maximums}
@!opt_tmp:integer; {index/scratch variable}

@ The |input_term_ln| routine waits for the user to type a line at his or her
terminal; then it puts ASCII-code equivalents for the characters on that line
into the |buffer| array. The |term_in| file is used for terminal input
and |term_out| is used for terminal output.
@↑system dependencies@>

@<Glob...@>=
@!buffer:array[0..file_line_length+1] of ASCII_code;
@!term_in:text_file; {the terminal, considered as an input file}
@!term_out:text_file; {the terminal, considered as an output file}

@ Since the terminal is being used for both input and output, some systems
need a special routine to make sure that the user can see a prompt message
before waiting for input based on that message. (Otherwise the message
may just be sitting in a hidden buffer somewhere, and the user will have
no idea what the program is waiting for.) We shall call a system-dependent
subroutine |update_terminal| in order to avoid this problem.
@↑system dependencies@>

@d update_terminal == break(term_out) {empty the terminal output buffer}

@ During a dialog, \.{DVIAPS} will treat the first percent sign in a
line as the end of that line.  Since \.{DVIAPS} may look on character
beyond the end of the user input, |input_term_ln| makes sure that there are
always at least two percent signs at the end of |buffer|.
@↑system dependencies@>

@p procedure input_term_ln; {inputs a line from the terminal}
begin update_terminal; reset(term_in);
if eoln(term_in) then read_ln(term_in);
buf_len:=0;
while (buf_len<file_line_length)and not eoln(term_in) do
  begin buffer[buf_len]:=xord[term_in↑]; incr(buf_len); get(term_in);
  end;
buffer[buf_len]:="%"; buffer[buf_len+1]:="%";
end;

@ We may also read from a disk option file.

@p procedure input_ln(var f:text_file); {inputs a line from disk}
begin
buf_len:=0;
if not eof(f) then begin
	while (buf_len<file_line_length)and not eoln(f) do
		begin buffer[buf_len]:=xord[f↑]; incr(buf_len); get(f);
		end;
	read_ln(f);
	end;
buffer[buf_len]:="%"; buffer[buf_len+1]:="%";
end;

@ The global variable |buf_ptr| is used while scanning each line of input;
it points to the first unread character in |buffer|, while |buf_len| tells
how many characters there are to look at.

@<Glob...@>=
@!buf_ptr:0..file_line_length; {the number of characters read}
@!buf_len:0..file_line_length; {total characters on line}

@ Here is a routine that scans a (possibly signed) integer and
computes the decimal value. If no decimal integer starts at |buf_ptr|,
the value 0 is returned and |got_error| is set true. The integer
should be less than $2↑{31}$ in absolute value.

@d skip_spaces==while buffer[buf_ptr]=" " do incr(buf_ptr)

@p function get_integer:integer;
var x:integer; {accumulates the value}
begin
skip_spaces;
got_sign:=+1;
while (buffer[buf_ptr]="-") or (buffer[buf_ptr]="+") or
		(buffer[buf_ptr]=" ") do
	begin
	if buffer[buf_ptr]="-" then got_sign:=-got_sign;
	incr(buf_ptr);
	end;
x:=0; got_length:=0;
while (buffer[buf_ptr]>="0")and(buffer[buf_ptr]<="9") do
  begin x:=10*x+buffer[buf_ptr]-"0"; incr(buf_ptr); incr(got_length);
  end;
get_integer:=got_sign*x;
got_error:=got_length=0;
end;

@ We make the variable |got_sign| global so that the |get_real| routine
can make use of the |get_integer| routine.  That's also the reason for
the variable |got_length|.  The |got_error| variable is set to |false|
when a valid item is scanned.

@<Glob...@>=
@!got_sign:-1..+1; {should the value be negated?}
@!got_length:integer; {digits in integer, including leading zeros}
@!got_error:boolean; {flags illegal format for scan}

@ And here is the promised |get_real| routine.  Note that it may call
|get_integer| twice, and if either of those calls finds a number,
then |got_error| is set |false|.

@p function get_real:real;
var r:real; {accumulates the value}
@!z:integer; {integer part}
@!s:-1..+1; {sign on integer part}
@!a:integer; {fractional part}
@!t:integer; {powers of ten}
@!res_error:boolean; {resulting value of |got_error|}
begin
z:=get_integer; {get integer part of real number}
res_error:=got_error;
s:=got_sign; {save sign for later, in case |z=0|}
if buffer[buf_ptr]="." then begin
	incr(buf_ptr);
	a:=get_integer;
	if res_error then res_error:=got_error;
	t:=1; while got_length>0 do begin t:=10*t; decr(got_length); end;
	get_real:=z+s*a/t;
	end
else get_real:=z;
got_error:=res_error;
end;

@ We also need to scan dimension names, and return the conversion factor
to units of points.  The |get_dimen| routine does this, and it sets
|got_error| to |true| if it doesn't find a legal dimension.

@d dimen_code(#)==256*#+

@p function get_dimen:real;
var code:0..65535; {sixteen bit ASCII value of two-character dimension code}
begin
got_error:=false;
skip_spaces;
lower_case(buffer[buf_ptr]);
lower_case(buffer[buf_ptr+1]);
code:=buffer[buf_ptr]*256+buffer[buf_ptr+1];
if code=dimen_code("p")("t") then get_dimen:=1.0 {points}
else if code=dimen_code("i")("n") then get_dimen:=72.27 {inches}
else if code=dimen_code("p")("c") then get_dimen:=12 {picas}
else if code=dimen_code("c")("m") then get_dimen:=72.27/2.54 {centimeters}
else if code=dimen_code("m")("m") then get_dimen:=72.27/25.4 {millimeters}
else if code=dimen_code("b")("p") then get_dimen:=72.27/72 {bigpoints}
else if code=dimen_code("m")("i") then get_dimen:=72.27/2540 {micas}
else if code=dimen_code("d")("d") then get_dimen:=72.27/(26.6*2.54) {didots}
else if code=dimen_code("c")("c") then get_dimen:=12*72.27/(26.6*2.54) {cicero}
else begin get_dimen:=1.0; got_error:=true; end;
buf_ptr:=buf_ptr+2;
end;

@ This routine combines |get_real| and |get_dimen| in order to scan a
distance.  The results are returned in units of $2↑{-16}$pt.  It causes
|got_error| to be set to |true| or |false|, depending;

@p function get_distance:integer;
var r:real;
begin
r:=get_real; {force expression evaluation order}
if not got_error then get_distance:=round(65536.0*r*get_dimen);
end;

@ Here's the procedure that does the real work of processing a single
option line.  This procedure may be called recursively, if the user
specifies the at-sign option.

@d skip_letters==repeat incr(buf_ptr); lower_case(buffer[buf_ptr]);
	until (buffer[buf_ptr]<"a") or (buffer[buf_ptr]>"z")

@p procedure read_option_file; forward; {mutual recursion possible}
procedure do_option_line; {assumes that line is in |buffer|}
var
  opt_tmp:integer; {index/scratch variable}
  orig_next_high:integer; {scratch variable}
begin
got_error:=false;
buf_ptr:=0; skip_spaces;
cmd:=buffer[buf_ptr]; {save first letter of command}
if cmd>"@@" then skip_letters
else if cmd<>"%" then incr(buf_ptr);
while (buffer[buf_ptr]="=") or (buffer[buf_ptr]=":") or (buffer[buf_ptr]=" ")
	do incr(buf_ptr); {skip over delimiters}
lower_case(cmd);
case cmd of
	"@@": read_option_file;
	"e": @<Handle erase XY option@>;
	"c": @<Handle first cycle position option@>;
	"d": @<Handle dump option@>;
	"i": @<Handle interactive option@>;
	"m": @<Handle magnification option@>;
	"n": @<Handle number of pages option@>;
	"p": @<Handle paper width specification@>;
	"t": @<Handle title option@>;
	"w": @<Handle white space option@>;
	"x": @<Handle XY option@>;
	"?": @<Display option settings@>;
	"!": @<Handle hardware specification@>;
	"%": do_nothing; {comment line}
	othercases print_ln('Illegal option initial: ',xchr[cmd]);
	endcases;
skip_spaces;
if buffer[buf_ptr]<>"%" then got_error:=true;
if got_error then print_ln('Illegal option parameter value');
end;

@ @<Glob...@>=
@!cmd:ASCII_code;

@ The option that specifies the maximum number of pages to be output
is the simplest, so we'll do it first.

@<Set option default values@>=
max_pages:=infinity;

@ @<Handle number of pages option@>=
begin
max_pages:=get_integer;
if got_error then max_pages:=infinity;
end

@ @<Handle interactive option@>=
begin
max_pages:=0;  {signals interactive mode...}
end

@ The option that specifies the override magnification is similar.

@<Set option default values@>=
use_mag:=def_mag;

@ @<Handle magnification option@>=
begin
use_mag:=get_integer;
if use_mag<0 then got_error:=true;
if got_error then use_mag:=def_mag;
end

@ The title option is different, because it handles text.  Note that this
program keeps adding more text to the title each time it is called,
unless it gets called with an empty argument, in which case it cancels
all of the user title input.  If the argument is a lone dash, then the
title is turned off altogether.

@<Handle title option@>=
begin
if (buffer[buf_ptr]="-")and(buffer[buf_ptr+1]="%") then begin
	do_title:=false;
	incr(buf_ptr);
	end
else if buffer[buf_ptr]="%" then begin
	do_title:=true;
	long_id1_length:=id1_length;
	end
else begin
	do_title:=true;
	next1(" ");
	repeat
		next1(buffer[buf_ptr]);
		incr(buf_ptr);
	until buffer[buf_ptr]="%";
	end;
end

@ @<Set option default values@>=
do_title:=true;

@ The white space option is actually a combination of |min_top_space|,
|max_top_space| and |bot_space|.  Use a quarter inch of space by default.

@d def_space==round(0.25*72.27*65536.0)

@<Set option default values@>=
min_top_space:=def_space; max_top_space:=def_space;
bot_space:=0;

@ If not all three values are specified, the unspecified values default
to the last specified one.  The middle value can be left unspecified
even if the last one is specified, as in \.{W 11pt,,33pt}

@d skip_comma==
	begin
	skip_spaces;
	if buffer[buf_ptr]="," then incr(buf_ptr);
	skip_spaces;
	end

@<Handle white space option@>=
begin
min_top_space:=get_distance;
if got_error then min_top_space:=def_space
else begin
	skip_comma;
	if (buffer[buf_ptr]=",") or (buffer[buf_ptr]="%") then begin
		max_top_space:=min_top_space;
		if buffer[buf_ptr]="," then incr(buf_ptr);
		end
	else max_top_space:=get_distance;
	if got_error then max_top_space:=def_space
	else begin
		skip_comma;
		if buffer[buf_ptr]="%" then bot_space:=max_top_space
		else bot_space:=get_distance;
		if got_error then bot_space:=0;
		end;
	end;
end

@ We will see later how this works, but the idea is that we have to
change the three white space values to \.{APS} units.

@d un_conv(#)==#:=round(#*resolution*use_mag/(65536.0*72.27*1000.0))

@<Do computations that depend on user options@>=
un_conv(max_top_space); un_conv(min_top_space); un_conv(bot_space);

@ There might be any number of \.{XY} instructions, so during the dialog
we'll keep them in upper memory, and copy them down later on.  Since
this is the only use of upper memory during the dialog, we can keep
things simple: |next_high| points to the end of a list of \.{XY} entries
that begins at |mem_max|.

@<Set option default values@>=
@<Wipe out temporary memory@>;
xy_count:=0;
xy_initialized:=false;

@ Doing an \.{XY} command involves scanning the X parameter and putting
it in high memory, and then doing the same for the Y parameter.
In addition, the XY coordinates may optionally be followed by a 4--tuple
of crop mark coordinates.

@<Handle XY option@>=
begin
orig_next_high:=next_high; {save this for easy error recovery}
high_int(get_distance);
if not got_error then begin
	skip_comma;
	high_int(get_distance);
	if got_error then next_high:=orig_next_high {forget it, no Y supplied}
	else begin {next check for crop mark coordinates}
	    skip_comma;
	    if buffer[buf_ptr]<>"%" then begin
                for opt_tmp:=1 to 4 do begin {process crop mark specs}
		    if not got_error then begin
		        high_int(get_distance);
		        skip_comma;
			end;
		    end;
		if got_error then {whoops, bad crop mark specs}
		    next_high:=orig_next_high
		else
	            incr(xy_count); {it's official}
	        end
	    else begin {no crop mark specs, apply defaults}
	        high_int(0);
	        high_int(0);
	        high_int(0);
	        high_int(0);
	        incr(xy_count); {it's official}
	        end
	    end
	end
else next_high:=orig_next_high; {forget it, no X supplied}
end

@ So the Erase command is easy:

@<Handle erase XY option@>=
begin
@<Wipe out temporary memory@>;
xy_count:=0;
end

@ After the user is done giving options, we move the \.{XY} list down to
permanent memory, leaving a pointer to the beginning of the list in
|xy_start|.  The list is terminated with a single word with the
value |infinity|.  If no \.{XY} commands were given, we use a default list
with one entry: \.{XY .25in, .25in}

@<Clean up option values@>=
if xy_count=0 then begin
	high_int(round(0.25*72.27*65536.0));
	high_int(round(0.25*72.27*65536.0));
	high_int(0);
	high_int(0);
	high_int(0);
	high_int(0);
	xy_count:=1;
	end;
xy_start:=next_low;
xy_pointer:=mem_max;
repeat
	low_mem(mem[xy_pointer]);
	decr(xy_pointer);
until xy_pointer=next_high; {this loop is done |6*xy_count| times}
low_int(infinity); {end marker}
xy_initialized:=true;

@ OK, we've saved up enough globals that have to be declared.

@<Glob...@>=
@!xy_start: mem_loc; {points to start of list of \.{XY} values}
@!xy_pointer: mem_loc; {points to current position in list of \.{XY} values}
@!xy_count: integer; {number of \.{XY} values specified}
@!xy_first: integer; {number of first \.{XY} value to use}
@!xy_initialized: boolean; {set true when \.{XY} initialization is finished}

@ We have to change the \.{XY} values to \.{DVI} units later on, when the
conversion factor is kown.

@<Do computations that depend on |conv|@>=
xy_pointer:=xy_start;
repeat
	mem[xy_pointer].int:=round(mem[xy_pointer].int*
		resolution/(72.27*65536.0*conv));
	incr(xy_pointer);
until mem[xy_pointer].int=infinity; {this loop is done |6*xy_count| times}

@ The \.{C} command tells where in the \.{XY}-cycle we want the first \.{DVI}
page to start.

@<Set option default values@>=
xy_first:=0;

@ @<Handle first cycle position option@>=
begin
xy_first:=get_integer;
if got_error then xy_first:=0;
end

@ This happens later, as the job is about to begin.  We handle the
non-standard |mod| operator with care;

@<Set |xy_pointer| depending on |xy_first|@>=
xy_first:=xy_first mod xy_count;
while xy_first<0 do xy_first:=xy_first+xy_count;
xy_pointer:=xy_start+6*xy_first;

@ The dump option sets a flag causing \.{DVIAPS} to dump out in
mneumonic form all the typesetter commands it generates as it writes
them to the output file.

@<Handle dump option@>=
begin
  if buffer[buf_ptr]<>"%" then
    begin
      dump_count := get_integer;
      if got_error then
        begin
          dump_count:=0;
          dump_begin:=infinity;
        end
      else
        begin
          dump_begin:=0;
          skip_comma;
          if buffer[buf_ptr]<>"%" then
            begin
              dump_begin := get_integer;
              if got_error then dump_begin:=0;
            end;
        end;
    end
  else
    begin
      dump_count:=infinity;
      dump_begin:=0;
    end;
end

@ This program can easily watch for characters that drop off the left
edge of the paper, by looking for negative horizontal coordinates.  It's
a little harder to look for characters that drop off the right edge,
since different paper widths may be in use at different times.  The best
we can do is to let the user specify the paper width so we can keep an
eye on characters that may fall beyond.  We also make sure that the rules
between pages show the maximum paper width.  Thus, by looking at a single
page of output and seeing that the rules fit on the paper, the user can
be sure that the whole job is OK.

@<Handle paper width specification@>=
begin
paper_width:=get_distance;
if paper_width<=0 then got_error:=true;
if got_error then paper_width:=round(722.7*65536);
end

@ We have to put the paper width into \.{DVI} units, remembering that
the value given is a true width, not magnified.

@<Do computations that depend on user options@>=
paper_width:=round((1000.0/use_mag)*paper_width/
	(72.27*65536.0*numerator/(254000.0*denominator)));

@ We assume ten inch wide paper by default.

@<Set option default values@>=
paper_width:=round(10.0*72.27*65536.0);

@ In spite of Autologic's claim that \.{ICL} is standard, there are
some things that must be handled differently on APS-5's and
APS-micro-5's, and some things that are different depending on whether
your APS is on-line, or if you communicate with it via tape.  The
|micro| and |macro| flags determine whether we're producing output for
a micro-5 or its big brother.  Likewise, |tape| and |online| tell
whether the machine is talked to via a tape drive on if it's directly
on line to the computer.  We should always have |micro=not macro| and
|online=not tape|.  The defaults shown here are probably the most
conservative choice.

An ``a'' option (for ``ancient'') exists for APS-5s with serial
numbers below 125.  If this option is set, then DVIAPS picks different
instruction sequences in some cases since the older APS-5s have some
missing or half-working instructions that might cause problems otherwise.

An ``m'' option (for ``magnification'') exists to allow extra font
magnification.  At some APS-5 installations a hardware ``patch'' has
been made to allow fonts to be magnified upto 25 percent beyond their
rated master size.  Setting this option causes \.{DVIAPS} to make use
of this extra capability.

Also, a ``7'' option (for ``70'') exists for use with 70--pica models
having larger, 12pt, 24pt, 48pt, 96pt range sizes.  In this case, and
extra 20 percent magnification beyond the 10pt, 20pt, 40pt, 80pt master
font design sizes is possible for each range.  Setting this option causes
\.{DVIAPS} to make use of this extra capability.

@<Set option default values@>=
macro:=true; micro:=false;
tape:=true; online:=false;
ancient_APS:=false;
extra_magnification_allowed:=false;
APS_70_pica:=false;

@ We have to be careful to avoid letting the user specify conflicting
hardware options.  The hardware option command (|"!"|) is intentionally
hidden from general users, and is expected to only show up in the
\.{APSfonts:DVIAPS.OPT} file.
@.APSfonts@>
@.DVIAPS.OPT@>

@<Handle hardware specification@>=
begin
while buffer[buf_ptr]<>"%" do begin
	cmd:=buffer[buf_ptr];
	lower_case(cmd);
	case cmd of
	" ": do_nothing; {spaces allowed in the hardware command string}
	"u": begin micro:=true; macro:=false; end;
	"5": begin macro:=true; micro:=false; end;
	"o": begin online:=true; tape:=false; end;
	"t": begin online:=false; tape:=true; end;
	"a": begin ancient_APS:=true; end;
	"m": begin extra_magnification_allowed:=true; end;
	"7": begin APS_70_pica:=true; end;
	othercases print_ln('Illegal hardware option: ',xchr[cmd]);
	endcases;
	incr(buf_ptr);
	end;
end

@ Here's where the possible recursion in reading option files comes
in.  We have to use a local file variable, since option files might
input other option files.  On systems where local files are not
supported, the code may be changed in one of a few ways: 1)~Use a
global array of files ala \TeX; 2)~Make the |opt_file| global, and
disallow recursive option files.
@↑system dependencies@>

@p procedure read_option_file;
var @!opt_file: text_file; {file of options}
@!k:0..name_length; {option file name length}
begin
@<Open the option file@>;
repeat
	input_ln(opt_file);
	if buf_len>0 then do_option_line; {empty lines are comments}
until eof(opt_file);
@<Close the option file@>;
end;

@ The name of the option file to read is in |buffer| starting at
position |buf_ptr|.  We have to do some system-dependent things
to open a file with the given name.  We're allowed to clobber the
entire buffer, if necessary.
@↑system dependencies@>

@<Open the option file@>=
begin
k:=0;
while (buffer[buf_ptr]<>"%") and (k<name_length-5) do begin
	incr(k);
	cur_name[k]:=xchr[buffer[buf_ptr]];
	incr(buf_ptr);
	end;
incr(k); cur_name[k]:='.';
incr(k); cur_name[k]:='O';
incr(k); cur_name[k]:='P';
incr(k); cur_name[k]:='T';
while k<name_length do begin incr(k); cur_name[k]:=' '; end;
reset(opt_file,cur_name);
end

@ Some systems require us to close `local' files.

@<Close the option file@>=
close(opt_file)

@ Tedious, but easy:

@<Display option settings@>=
begin
print_nl;
print_ln('DVIAPS Option Settings: ');
print_nl;
@<Display the title option setting@>;
print('  Number of pages: ');
if max_pages=infinity then print_ln('all')
else print_ln(max_pages:1);
print_ln('  Paper width: ',paper_width/65536.0/72.27:1:2,'in, ',
	paper_width/65536.0/72.27*25.4:1:1,'mm, ',
	paper_width/65536.0:1:1,'pt');
print('  Assumed output path/device: ');
@!zilog
print('!!! ZILOG !!! ');
goliz
if micro then print('APS-micro-5');
if macro then print('APS-5');
if APS_70_pica then print(', 70-pica model');
if tape then print(', tape');
if online then print(', online');
if ancient_APS then print(', pre-125 serial number');
if extra_magnification_allowed then
 print(', font magnification allowed to 25% beyond nominal range sizes');
print_nl;
print('  Magnification: ',use_mag:1);
if use_mag=def_mag then print(' (the magnification set in the DVI file)');
print_nl;
@<Display the white space option setting@>;
@<Display the XY option setting@>;
print_ln('  Cycle: ',xy_first:1);
end

@ @<Display the title option setting@>=
if do_title then begin
	print('  Title: "');
	for opt_tmp:=1 to long_id1_length do
		print(xchr[id1_string[opt_tmp]]);
	print_ln('"');
	end
else print_ln('  Title: none')

@ @<Display the white space option setting@>=
begin
print('  White space control: ');
if xy_initialized then begin
	print_ln(min_top_space/resolution:1:2,'in <= top space <= ',
	max_top_space/resolution:1:2,'in, page depth >= ',
	bot_space/resolution:1:2,'in');
	end
else begin
	print_ln(min_top_space/72.27/65536.0:1:2,'in <= top space <= ',
	max_top_space/72.27/65536.0:1:2,'in, page depth >= ',
	bot_space/72.27/65536.0:1:2,'in');
	end;
end

@ @<Display the XY option setting@>=
begin
print_ln('  XY coordinates: ');
if xy_count=0 then print_ln('    0.25in, 0.25in; no crop marks (default)')
else if xy_initialized then begin
	xy_pointer:=xy_start;
	while mem[xy_pointer].int<>infinity do begin
		print('    ');
		{have to convert back to points from DVI units}
		print(mem[xy_pointer].int*conv/resolution:1:2,'in,');
		incr(xy_pointer);
		print(mem[xy_pointer].int*conv/resolution:1:2,'in');
		incr(xy_pointer);
		if (mem[xy_pointer+2].int>0) and (mem[xy_pointer+3].int>0)
		then begin
			print('; crop marks: ');
			for opt_tmp:=1 to 4 do begin {print crop mark specs}
				print(mem[xy_pointer].int*conv/resolution
				  :1:2,'in');
				if opt_tmp<4 then print(',');
				incr(xy_pointer);
				end;
			end
		else begin
			print('; no crop marks');
			xy_pointer:=xy_pointer+4;
			end;
                print_nl;
		end
	end
else begin
	xy_pointer:=mem_max;
	while xy_pointer>next_high do begin
		print('    ');
		print(mem[xy_pointer].int/72.27/65536.0:1:2,'in,');
		decr(xy_pointer);
		print(mem[xy_pointer].int/72.27/65536.0:1:2,'in');
		decr(xy_pointer);
		if (mem[xy_pointer-2].int>0) and (mem[xy_pointer-3].int>0)
		then begin
			print('; crop marks: ');
			for opt_tmp:=1 to 4 do begin {print crop mark specs}
				print(mem[xy_pointer].int/72.27/65536.0
					:1:2,'in');
				if opt_tmp<4 then print(',');
				decr(xy_pointer);
				end;
			end
		else begin
			print('; no crop marks');
			xy_pointer:=xy_pointer-4;
			end;
                print_nl;
		end
	end;
end

@ The selected options are put into global variables by the |option_dialog|
procedure, which is called just as \.{DVIAPS} begins.
@↑system dependencies@>

@p procedure option_dialog;
var opt_file: text_file; {file of options}
begin
@<Set option default values@>;
reset(opt_file,'APSfonts:DVIAPS.OPT');
repeat
	input_ln(opt_file);
	if buf_len>0 then do_option_line; {empty lines are comments}
until eof(opt_file);
@.APSfonts@>
@.DVIAPS.OPT@>
@<Close the option file@>;
repeat
	write(term_out,'DVIAPS option> '); update_terminal;
	input_term_ln;
	do_option_line;
until buf_len=0;
@<Clean up option values@>;
end;

@* Defining fonts.
When |random_reading=true|, \.{DVIAPS} reads the postamble first and loads
all of the fonts defined there; then it processes the pages. In this
case, a \\{fnt\_def} command should match a previous definition if and only
if the \\{fnt\_def} being processed is not in the postamble. But if
|random_reading=false|, \.{DVIAPS} reads the pages first and the postamble
last, so the conventions are reversed: a \\{fnt\_def} should match a previous
\\{fnt\_def} if and only if the current one is a part of the postamble.

@ The following subroutine does the necessary things when a \\{fnt\_def}
command is being processed.  Note that we don't notice if a font is
declared more than once the same way, since we may hop around in the
\.{DVI} file and see the same definition twice.

@d bad_font(#)==begin
	print('Font ');
@.Font x...@>
	for r:=1 to fnam_len do print(xchr[fnam[r]]);
	print_ln(#);
	end

@p procedure define_font(@!e:integer); {|e| is an external font number}
label done;
var f:0..max_fonts;
@!p:integer; {length of the area/directory spec}
@!n:integer; {length of the font name proper}
@!c,@!q,@!d:integer; {check sum, scaled size, and design size}
@!r:0..name_length; {index into |cur_name|}
@!j,@!k:0..name_size; {indices into |names|}
@!min_mag: integer; {minimum acceptable magnification for this font}
@!best_mag: integer; {best magnification found}
@!fptr: -1..mem_max; {search for font availability list, if -1 then none exists}
@!pos: integer; {helps in font search}
@!t: integer; {powers of ten}

begin if nf=max_fonts then abort('DVIAPS capacity exceeded (max fonts=',
    max_fonts:1,')!');
@.DVIAPS capacity exceeded...@>
font_num[nf]:=e; f:=0;
while font_num[f]<>e do incr(f);
@<Read the font parameters into position for font |nf|@>;
if f=nf then @<Load the new font, unless there are problems@>
else @<Check that the current font definition matches the old one@>;
end;

@ @<Check that the current...@>=
{font name check is omitted}
begin if font_check_sum(f)<>c then
  bad_font('---check sum doesn''t match previous definition!');
@.check sum doesn't match@>
if font_design_size(f) div 16<>d then
  bad_font('---design size doesn''t match previous definition!');
@.design size doesn't match@>
end

@ @<Read the font parameters into position for font |nf|@>=
c:=signed_quad; {checksum from |tfm_file|}
q:=signed_quad; {scaled size from |tfm_file|}
d:=signed_quad; {design size from |tfm_file|}
p:=get_byte; {area length} n:=get_byte; {name length}
if n=0 then bad_font('empty font name!');
@.empty font name@>
if (n>name_length) or (p>name_length) then
  abort('DVIAPS capacity exceeded (font name length=',name_length:1,')!');
@.DVIAPS capacity exceeded...@>
if p>0 then for k:=1 to p do fnam[k]:=get_byte;
fnam_len:=n;
if n>0 then for k:=1 to n do fnam[k]:=get_byte;
if n<name_length then for k:=n+1 to name_length do fnam[k]:=" ";

@ @<Load the new font, unless there are problems@>=
begin
@!debug
print('Loading font ');
for r:=1 to fnam_len do print(xchr[fnam[r]]);
print_nl;
gubed@/
if (q<=0)or(q>=@'1000000000) then begin
    bad_font('---not loaded, bad scale (',q:1,')!');
@.bad scale@>
    goto done;
    end;
if (d<=0)or(d>=@'1000000000) then begin
    bad_font('---not loaded, bad design size (',d:1,')!');
@.bad design size@>
    goto done;
    end;
@!debug
print_ln(' Design size is ',d/65536:4:3);
print_ln(' Scaled size is ',q/65536:4:3);
gubed@/
@<Figure out the best choice among the available magnifications@>;
@<Move font name into the |cur_name| string@>;
if not open_AMF_file then begin
        bad_font('---not loaded, AMF file can''t be opened!');
@.AMF file can\'t be opened@>
    goto done;
    end;
if not in_AMF(q) then goto done;
@<Finish loading the new font info@>;
done:
end

@ @<Finish loading...@>=
if (c<>0)and(font_check_sum(nf)<>0)and(c<>font_check_sum(nf)) then
  begin bad_font('---beware: check sums do not agree!');
@.beware: check sums do not agree@>
@.check sums do not agree@>
  print_ln('   (',c:1,' vs. ',font_check_sum(nf):1,')');
  end;
font_check_sum(nf):=c; {so it will match next time around}
if font_design_size(nf) div 16<>d then
  begin bad_font('---beware: design sizes do not agree!');
@.beware: design sizes do not agree@>
@.design sizes do not agree@>
  print_ln('   (',d:1,' vs. ',font_design_size(nf) div 16:1,')');
  font_design_size(nf):=d*16; {so it will match next time around}
  end;
@{
{disable the following since \.{PLFONT} always sets |font_magnification|
 to 1000 currently}
if font_magnification(nf)<>best_mag then
  begin bad_font('---beware: font lies about its magnification!');
@.beware: font lies...@>
@.font lies...@>
  print_ln('   (',best_mag:1,' vs. ',font_magnification(nf):1,')');
  end;
@}
incr(nf); {now the new font is officially present}

@ We have to look at the list of magnifications that this font
is available in, and pick the one that's the smallest one that's
at least as large as |min_mag|.

If |extra_magnification_allowed| is true adjust things so that any APS font
can be blown up to 25\% beyond its nominal range size maximum.  This
is accomplished, albeit a bit indirectly, by reducing |min_mag|.

Likewise, for 70--pica models an extra 20\% magnification is allowed for
all fonts.  It is legal to set both |extra_magnification| and |APS_70_pica|.

If this font doesn't show up in AMF.LST at all, assume magnification 1000.

@<Figure out the best choice among the available magnifications@>=
if extra_magnification_allowed and APS_70_pica then
	min_mag:=round(use_mag*(q/d)/(1.25*1.2))
else if extra_magnification_allowed then
	min_mag:=round(use_mag*(q/d)/1.25)
else if APS_70_pica then
	min_mag:=round(use_mag*(q/d)/1.2)
else min_mag:=round(use_mag*(q/d));
best_mag:=infinity;
@!debug
print_ln(' Minimum suitable magnification is ',min_mag:1);
gubed@/
@<Point |fptr| to the list of available magnifications@>;
if fptr>-1 then
  while mem[fptr].int>0 do begin
	  if (mem[fptr].int<best_mag) and (mem[fptr].int>=min_mag)
	  then best_mag:=mem[fptr].int;
	  incr(fptr);
	  end
else begin
	{no entry in AMF.LST, try a default value of 1000}
	if 1000>=min_mag then best_mag:=1000;
	end;
if best_mag=infinity then begin
	bad_font('---magnification not available: ',min_mag:1);
@.magnification not available@>
	best_mag:=1000;
	end;
font_multiplier:=(q/@'4000000);
@!debug
print_ln(' Best magnification found is ',best_mag:1);
print_ln(' Font multiplier is ',font_multiplier:4:3);
gubed

@ Do a simple linear search through the list of available fonts to find
the one with the matching name.  If none is found, set |fptr| to -1.

@<Point |fptr| to the list of available magnifications@>=
fptr:=-1;
if AMF_end>=AMF_begin then
  begin
    pos:=AMF_begin;
    while (pos<=AMF_end) and (fptr=-1) do
      begin
        if fnam_compare(mem[pos].int)=0 then fptr:=pos;
        pos := pos + 1;
      end;
  end;
if fptr>-1 then
  begin
    fptr:=mem[fptr].int;
    fptr:=fptr+(mem[fptr].qqqq.b0+4) div 4;
  end;

@ \.{DVIAPS} always uses the default font directory to look for \.{AMF}
files, whether or not |p=0|.  The name of this area is kept in
|default_directory|, a system-dependent place where the standard fonts
are kept.
@↑system dependencies@>
@.APSfonts@>

@d default_directory_name=='APSfonts:' {change this to the correct name}
@d default_directory_name_length=9 {change this to the correct length}

@<Glob...@>=
@!default_directory:packed array[1..default_directory_name_length] of char;

@ @<Set init...@>=
default_directory:=default_directory_name;

@ The string |cur_name| is supposed to be set to the external name of
the \.{AMF} file for the current font. This means that we need
to prepend the name of the default directory, and to append the proper
suffix.
@↑system dependencies@>

@<Move font name into the |cur_name| string@>=
for k:=1 to name_length do cur_name[k]:=' ';
for k:=1 to default_directory_name_length do
    cur_name[k]:=default_directory[k];
r:=default_directory_name_length;
for k:=1 to fnam_len do
  begin incr(r);
  if r+8>name_length then
    abort('DVIAPS capacity exceeded (max font name length=',
      name_length:1,')!');
@.DVIAPS capacity exceeded...@>
  cur_name[r]:=xchr[fnam[k]];
  end;
incr(r); cur_name[r]:='.';
@<Tack the font scaling factor onto |cur_name|@>;
cur_name[r+1]:='A'; cur_name[r+2]:='M'; cur_name[r+3]:='F';

@ Here we have to convert |best_mag| to its ASCII decimal equivalent.

@<Tack the font scaling factor onto |cur_name|@>=
t:=10; while t<=best_mag do t:=t*10;
repeat
  t:=t div 10;
  incr(r); cur_name[r]:=xchr["0"+((best_mag div t) mod 10)];
until t=1;

@* Translating from Device Independent format.
Half of the main work of \.{DVIAPS} is accomplished by the |read_DVI|
procedure, which produces the output for an entire page, assuming that
the |bop| command for that page has already been processed. This
procedure is essentially an interpretive routine that reads and acts
on the \.{DVI} commands.

The format of \.{DVI} files is documented in the companion program
\.{DVItype}, and will not be repeated here.

@d set_char_0=0 {typeset character 0 and move right}
@d set1=128 {typeset a character and move right}
@d set_rule=132 {typeset a rule and move right}
@d put1=133 {typeset a character}
@d put_rule=137 {typeset a rule}
@d nop=138 {no operation}
@d bop=139 {beginning of page}
@d eop=140 {ending of page}
@d push=141 {save the current positions}
@d pop=142 {restore previous positions}
@d right1=143 {move right}
@d w0=147 {move right by |w|}
@d w1=148 {move right and set |w|}
@d x0=152 {move right by |x|}
@d x1=153 {move right and set |x|}
@d down1=157 {move down}
@d y0=161 {move down by |y|}
@d y1=162 {move down and set |y|}
@d z0=166 {move down by |z|}
@d z1=167 {move down and set |z|}
@d fnt_num_0=171 {set current font to 0}
@d fnt1=235 {set current font}
@d xxx1=239 {extension to \.{DVI} primitives}
@d xxx4=242 {potentially long extension to \.{DVI} primitives}
@d fnt_def1=243 {define the meaning of a font number}
@d pre=247 {preamble}
@d post=248 {postamble beginning}
@d post_post=249 {postamble ending}
@d undefined_commands==250,251,252,253,254,255
@#
@d id_byte=2 {identifies the kind of \.{DVI} files used here}

@<Glob...@>=
@!p,@!q:integer; {parameters of \.{DVI} command}

@ The definition of \.{DVI} files refers to six registers,
$(h,v,w,x,y,z)$, which hold integer values in \.{DVI} units.

The stack of $(h,v,w,x,y,z)$ values is represented by six arrays
called |hstack|, \dots, |zstack|.

@<Glob...@>=
@!h,@!v,@!w,@!x,@!y,@!z:integer; {current state values}
@!hstack,@!vstack,@!wstack,@!xstack,@!ystack,@!zstack:
  array [0..stack_size] of integer; {pushed down values in \.{DVI} units}

@ A number of characteristics of the pages (their |max_v|, |max_h|, and
|max_s|) are specified in the postamble, along with other global
information about the \.{DVI} file.

@<Glob...@>=
@!conv:real; {converts \.{DVI} units to pixels}
@!numerator,@!denominator:integer; {stated conversion ratio}
@!def_mag:integer; {magnification factor times 1000 (from preamble)}
@!max_v:integer; {the value of |abs(v)| should probably not exceed this}
@!max_h:integer; {the value of |abs(h)| should probably not exceed this}
@!max_s:integer; {the stack depth should not exceed this}
@!max_s_so_far:integer; {the record high level of the stack}
@!total_pages:integer; {the stated total number of pages}
@!page_count:integer; {page number within \.{DVI} file}
@!done_page_count:integer; {number of pages processed}
@!done_cycle_count:integer; {number of output sheets produced}

@ @<Set init...@>=
max_v:=infinity; max_h:=infinity; max_s:=stack_size+1;@/
done_page_count:=0; done_cycle_count:=0; page_count:=1; {start at first page}
total_pages:=0; {flags that we haven't seen postamble yet}

@ Before we get into the details of |read_DVI|, it is convenient to
consider a simpler routine that computes the first parameter of each
opcode.

@d four_cases(#)==#,#+1,#+2,#+3
@d eight_cases(#)==four_cases(#),four_cases(#+4)
@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)

@p function first_par(o:eight_bits):integer;
begin case o of
sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64):
  first_par:=o-set_char_0;
set1,put1,fnt1,xxx1,fnt_def1: first_par:=get_byte;
set1+1,put1+1,fnt1+1,xxx1+1,fnt_def1+1: first_par:=get_two_bytes;
set1+2,put1+2,fnt1+2,xxx1+2,fnt_def1+2: first_par:=get_three_bytes;
right1,w1,x1,down1,y1,z1: first_par:=signed_byte;
right1+1,w1+1,x1+1,down1+1,y1+1,z1+1: first_par:=signed_pair;
right1+2,w1+2,x1+2,down1+2,y1+2,z1+2: first_par:=signed_trio;
set1+3,set_rule,put1+3,put_rule,right1+3,w1+3,x1+3,down1+3,y1+3,z1+3,
  fnt1+3,xxx1+3,fnt_def1+3: first_par:=signed_quad;
nop,bop,eop,push,pop,pre,post,post_post,undefined_commands: first_par:=0;
w0: first_par:=w;
x0: first_par:=x;
y0: first_par:=y;
z0: first_par:=z;
sixty_four_cases(fnt_num_0): first_par:=o-fnt_num_0;
end;
end;

@ Here is another subroutine that we need: It computes the number of
pixels in the height or width of a rule. Characters and rules will line up
properly if the sizes are computed precisely as specified here.  (Since
|conv| is computed with some floating-point roundoff error, in a
machine-dependent way, format designers who are tailoring something for a
particular resolution should not plan their measurements to come out to an
exact integer number of pixels; they should compute things so that the
rule dimensions are a little less than an integer number of pixels, e.g.,
4.99 instead of 5.00.)

@p function rule_pixels(x:integer):integer;
  {computes $\lceil|conv|\cdot x\rceil$}
var n:integer;
begin n:=trunc(conv*x);
if n<conv*x then rule_pixels:=n+1 @+ else rule_pixels:=n;
end;

@ Strictly speaking, the |read_DVI| procedure is really a function with
side effects, not a `\&{procedure}'; it returns the value |false| if
\.{DVIAPS} should be aborted because of some unusual happening. The
subroutine is organized as a typical interpreter, with a multiway branch
on the command code followed by |goto| statements leading to routines that
finish up the activities common to different commands. We will use the
following labels:

@d fin_set=41 {label for commands that set or put a character}
@d fin_rule=42 {label for commands that set or put a rule}
@d move_right=43 {label for commands that change |h|}
@d move_down=44 {label for commands that change |v|}
@d change_font=45 {label for commands that change |cur_font|}

@ Some \PASCAL\ compilers severely restrict the length of procedure bodies,
so we shall split |read_DVI| into two parts, one of which is
called |special_cases|. The different parts communicate with each other
via the global variables mentioned above, together with the following ones:

@<Glob...@>=
@!s:integer; {current stack size}
@!ss:integer; {stack size to print}
@!left_dropped_chars,@!total_left_dropped_chars: integer;
  {were characters dropped off the left?}
@!right_dropped_chars,@!total_right_dropped_chars: integer;
  {or off the right edge of the paper?}
@!max_left,@!gbl_max_left: integer; {how far left were they?}
@!max_right,@!gbl_max_right: integer; {how far right were they?}

@ @<Set init...@>=
total_left_dropped_chars:=0;
total_right_dropped_chars:=0;
gbl_max_left:=0;
gbl_max_right:=0;

@ Here is the overall setup.

@d error(#)==print_ln(' ',#)

@p @t\4@>@<Declare functions used by |read_DVI|@>@;
function read_DVI:boolean;
label fin_set,fin_rule,move_right,done,9997,9998,9999;
var o:eight_bits; {operation code of the current command}
@!a:integer; {byte number of the current command}
@!crop_x,@!crop_y,@!crop_ht,@!crop_wd,@!crop_len,
  @!crop_thk,@!crop_off,@!crop_tot:integer;
begin
right_dropped_chars:=0; max_right:=0;
left_dropped_chars:=0; max_left:=0; {no characters dropped yet}
cur_font:=nf; {set current font undefined}
cur_bc:=256; cur_ec:=-1; {no characters are valid}
s:=0; w:=0; x:=0; y:=0; z:=0;
h:=mem[xy_pointer].int; incr(xy_pointer);
v:=mem[xy_pointer].int; incr(xy_pointer);
@<Emit crop marks if necessary@>;
{initialize the state variables}
while true do @<Translate the next command in the \.{DVI} file;
    |goto 9999| with |read_DVI=true| if it was |eop|;
    |goto 9998| if premature termination is needed@>;
9998: print_ln('!'); read_DVI:=false;
9999:
if left_dropped_chars>0 then
	error(left_dropped_chars:1,' dropped characters; up to ',
		(-conv*max_left/resolution):1:2,
		'in too far to the left');
if right_dropped_chars>0 then
	error(right_dropped_chars:1,' dropped characters; up to ',
		(conv*(max_right-paper_width)/resolution):1:2,
		'in too far to the right');
@.n character up to...@>
end;

@ Various commands come together a |fin_set|, |fin_rule|, |move_right|
and |done|.

@<Translate the next command...@>=
begin a:=cur_loc;
o:=get_byte; p:=first_par(o);
if eof(dvi_file) then bad_dvi('the file ended prematurely');
@.the file ended prematurely@>
@<Start translation of command |o| and |goto| the appropriate label to
  finish the job@>;
fin_set: @<Finish a command that either sets or puts a character, then
    |goto move_right| or |done|@>;
fin_rule: @<Finish a command that either sets or puts a rule, then
    |goto move_right| or |done|@>;
move_right: h:=h+q;
done:
end

@ The multiway switch in |first_par|, above, was organized by the length
of each command; the one in |read_DVI| is organized by the semantics.

@<Start translation...@>=
if o<set_char_0+128 then goto fin_set
else case o of
  four_cases(put1): goto fin_set;
  four_cases(set1): goto fin_set;
  set_rule: goto fin_rule;
  put_rule: goto fin_rule;
  @t\4@>@<Cases for commands |nop|, |bop|, \dots, |pop|@>@;
  @t\4@>@<Cases for horizontal motion@>@;
  othercases if special_cases(o,p,a) then goto done@+else goto 9998
  endcases

@ Emit crop marks.  Crops marks can be optionally requested via the XY
command.

@<Emit crop marks if necessary@>=
begin
crop_len:=round(60/conv);  {crop mark length is 6pt, convert to DVI units}
crop_off:=round(40/conv);  {crop mark offset is 4pt, convert to DVI units}
crop_tot:=round(100/conv); {sum of crop mark length and offset}
crop_thk:=round(3/conv);  {crop mark thickness is .3pt, convert to DVI units}
@#
if (mem[xy_pointer+2].int>0) and (mem[xy_pointer+3].int>0) then begin
	{need to emit crop marks}
	crop_x:= mem[xy_pointer].int; incr(xy_pointer);
	crop_y:= mem[xy_pointer].int; incr(xy_pointer);
	crop_ht:= mem[xy_pointer].int; incr(xy_pointer);
	crop_wd:= mem[xy_pointer].int; incr(xy_pointer);
@#
	do_crop_mark(crop_len,crop_thk,crop_x-crop_tot,crop_y,
		crop_x-crop_thk,crop_y-crop_off);
	do_crop_mark(crop_len,crop_thk,crop_x+crop_wd+crop_off,crop_y,
		crop_x+crop_wd,crop_y-crop_off);
	do_crop_mark(crop_len,crop_thk,crop_x-crop_tot,crop_y+crop_ht+crop_thk,
		crop_x-crop_thk,crop_y+crop_ht+crop_tot);
	do_crop_mark(crop_len,crop_thk,crop_x+crop_wd+crop_off,
		crop_y+crop_ht+crop_thk,
		crop_x+crop_wd,crop_y+crop_ht+crop_tot);
@#
	h:=mem[xy_pointer-6].int; {restore original |h| and |v| values}
	v:=mem[xy_pointer-5].int;
	end
else begin {no need for crop marks}
	xy_pointer:=xy_pointer+4;
	end;
end

@ @<Declare functions used by |read_DVI|@>=
function special_cases(@!o:eight_bits;@!p,@!a:integer):boolean;
label change_font,move_down,done,9998;
var q:integer; {parameter of the current command}
@!k:integer; {loop index}
@!bad_char:boolean; {has a non-ASCII character code appeared in this \\{xxx}?}
@!pure:boolean; {is the command error-free?}
begin pure:=true;
case o of
@t\4@>@<Cases for vertical motion@>@;
@t\4@>@<Cases for fonts@>@;
four_cases(xxx1): @<Translate an |xxx| command and |goto done|@>;
pre: begin error('preamble command within a page!'); goto 9998;
  end;
@.preamble command within a page@>
post,post_post: begin error('postamble command within a page!'); goto 9998;
@.postamble command within a page@>
  end;
othercases begin error('undefined command ',o:1,'!');
  goto done;
@.undefined command@>
  end
endcases;
move_down: v:=v+p; goto done;
change_font: @<Finish a command that changes the current font,
  then |goto done|@>;
9998: pure:=false;
done: special_cases:=pure;
end;

@ @<Cases for commands |nop|, |bop|, \dots, |pop|@>=
nop: goto done;
bop: begin error('bop occurred before eop'); goto 9998;
@.bop occurred before eop@>
  end;
eop: begin
  if s<>0 then error('stack not empty at end of page (level ',
    s:1,')!');
@.stack not empty...@>
  read_DVI:=true;
  goto 9999;
  end;
push: begin
  if s=max_s_so_far then
    begin max_s_so_far:=s+1;
    if s=max_s then error('deeper than claimed in postamble!');
@.deeper than claimed...@>
@.push deeper than claimed...@>
    if s=stack_size then
      begin error('DVIAPS capacity exceeded (stack size=',
        stack_size:1,')'); goto 9998;
      end;
    end;
  hstack[s]:=h; vstack[s]:=v; wstack[s]:=w;
  xstack[s]:=x; ystack[s]:=y; zstack[s]:=z;
  incr(s); ss:=s-1; goto done;
  end;
pop: begin
  if s=0 then error('Illegal pop at level zero)!')
  else  begin decr(s);
    h:=hstack[s]; v:=vstack[s]; w:=wstack[s];
    x:=xstack[s]; y:=ystack[s]; z:=zstack[s];
    end;
  ss:=s; goto done;
  end;

@ Because the \.{APS} does rounding internally, we have no control over
single-pixel rounding effects.  But the positioning is accurate enough
that this shouldn't be a problem.

@d out_space== q:=p; goto move_right

@<Cases for horizontal motion@>=
four_cases(right1):begin q:=p; goto move_right; end;
w0,four_cases(w1):begin w:=p; q:=p; goto move_right; end;
x0,four_cases(x1):begin x:=p; q:=p; goto move_right; end;

@ Vertical motion is done similarly.

@<Cases for vertical motion@>=
four_cases(down1):goto move_down;
y0,four_cases(y1):begin y:=p; goto move_down; end;
z0,four_cases(z1):begin z:=p; goto move_down; end;

@ @<Cases for fonts@>=
sixty_four_cases(fnt_num_0): goto change_font;
four_cases(fnt1): goto change_font;
four_cases(fnt_def1): begin
  define_font(p); goto done;
  end;

@ @<Translate an |xxx| command and |goto done|@>=
begin bad_char:=false;
for k:=1 to p do
  begin q:=get_byte;
  if (q>=" ")and(q<="~") then
    begin {bug fixme error-message???}
    end
  else bad_char:=true;
  end;
if bad_char then error('non-ASCII character in xxx command!');
@.non-ASCII character...@>
goto done;
end

@ @<Finish a command that either sets or puts a character...@>=
if cur_ec=256 then p:=256; {width computation for oriental fonts}
if (p<cur_bc)or(p>cur_ec) then q:=invalid_width
else q:=char_width(p);
if q=invalid_width then error('character ',p:1,' invalid in font ',cur_font:1)
@.character $c$ invalid...@>
else @<Insert character |p|'s segments into the data structure@>;
if o>=put1 then goto done;
if q=invalid_width then q:=0;
goto move_right

@ It's easy to traverse the linked list of segments that make up the
current character.

@<Insert character |p|'s segments into the data structure@>=
begin
cur_sg:=char_sg_ptr(p);
orig_sg:=cur_sg;
cur_sg:=sg_ptr(cur_sg);
while cur_sg>0 do begin
	if sg_type(orig_sg)=segtype_short then
		@<Move short character segments into the default-settings
		segment@>;
	@<Insert current segment at current location into the data structure@>;
        @<Check for missing characters@>;
	cur_sg:=sg_next_sg;
        orig_sg:=cur_sg;
	end;
end

@ Short character segments pose a bit of a problem.  All defined names for
the fields are in terms of the full 16-word entry field displacements.
So, we copy the variable items for this entry onto the full-size character
segment describing the default values.

@<Move short character segments into the default-settings segment@>=
begin
        cur_pixel_width:=shrt_sg_pixel_width;
        cur_APS_char:=sg_char(shrt_sg_APS_info);
        cur_APS_font_index:=sg_font(shrt_sg_APS_info);
        cur_sg:=char_defaults_base(cur_APS_font_index);
	 {switch to the defaults entry}
        sg_pixel_width:=cur_pixel_width;
        sg_APS_char:=cur_APS_char;
        sg_next_sg:=0;
end

@ If |sg_APS_char| is zero, then the user must have set DEVCHAR=0 in
the PL file.  DVIAPS will not set a character in this case---just
leave blank space corresponding to the CHARWD setting.  Print a
warning when this happens.

@<Check for missing characters@>=
begin
  if sg_APS_char=0 then
    begin
      print('Warning: character ',p:0,', font ');
      print_font(cur_font);
      print_ln(', is unavailable (DEVCHAR was zero).');
    end;
end

@ @<Finish a command that either sets or puts a rule...@>=
q:=signed_quad;
if (p>0) and (q>0) then got_rule; {height |p|, width |q|}
if o=put_rule then goto done;
goto move_right

@ @<Finish a command that changes the current font...@>=
font_num[nf]:=p; cur_font:=0;
while font_num[cur_font]<>p do incr(cur_font);
if cur_font=nf then bad_dvi('reference to undeclared font');
cur_info:=font_info[cur_font];
cur_dir_base:=font_dir_base(cur_font);
cur_width_base:=font_width_base(cur_font);
cur_bc:=font_bc(cur_font);
cur_ec:=font_ec(cur_font);
goto done

@* Reading the pre/postamble.

A \.{DVI}-reading program that reads the postamble first need not
look at the preamble; but \.{DVIAPS} looks at the preamble in order to
do error checking, and to display the introductory comment.

@<Process the preamble@>=
open_dvi_file;
if eof(dvi_file) then bad_dvi('it''s empty');
@.it\'s empty@>
pp:=get_byte; {fetch the first byte}
if pp<>pre then bad_dvi('First byte isn''t start of preamble!');
@.First byte isn't...@>
pp:=get_byte; {fetch the identification byte}
if pp<>id_byte then
  print_ln('identification in byte 1 should be ',id_byte:1,'!');
@.identification...should be n@>
@<Process the conversion factor@>;
pp:=get_byte; {fetch the length of the introductory comment}
id2_length:=0;
while id2_length<pp do
  begin incr(id2_length); id2_string[id2_length]:=get_byte;
  end

@ The conversion factor |conv| is figured as follows: There are exactly
|n/d| \.{DVI} units per decimicron, and 254000 decimicrons per inch,
and |resolution| pixels per inch. Then we have to adjust this
by the stated amount of magnification.

@<Process the conversion factor@>=
numerator:=signed_quad; denominator:=signed_quad;
if numerator<=0 then bad_dvi('numerator is ',numerator:1);
@.numerator is wrong@>
if denominator<=0 then bad_dvi('denominator is ',denominator:1);
@.denominator is wrong@>
def_mag:=signed_quad;
if def_mag<=0 then bad_dvi('magnification is ',def_mag:1);
@.magnification is wrong@>

@ We won't know the final value of |use_mag| until later, so:

@<Do computations that depend on user options@>=
conv:=(numerator/254000.0)*(resolution/denominator)*(use_mag/1000.0);
@<Do computations that depend on |conv|@>;

@ @<Print the preamble id@>=
print('''');
for k:=1 to id2_length do print(xchr[id2_string[k]]);
print_ln('''');

@ Now imagine that we are reading the \.{DVI} file and positioned just
four bytes after the |post| command. That, in fact, is the situation,
when the following part of \.{DVIAPS} is called upon to read, translate,
and check the rest of the postamble.

If the |load_fonts| flag is set false on entry then the postamble scanning
is aborted early before loading all the fonts.  The call to |read_postamble|
at the beginning of |page_dialog| sets |load_fonts| to |false|.

@p procedure read_postamble(load_fonts:boolean);
var k:integer; {loop index}
@!p,@!q,@!m:integer; {general purpose registers}
begin
post_loc:=cur_loc-1;
backpointer:=signed_quad;
if backpointer<0 then bad_dvi('postamble backpointer ',backpointer:1);
@.postamble backpointer@>
first_backpointer:=backpointer;
if signed_quad<>numerator then
  print_ln('numerator doesn''t match the preamble!');
@.numerator doesn't match@>
if signed_quad<>denominator then
  print_ln('denominator doesn''t match the preamble!');
@.denominator doesn't match@>
if signed_quad<>def_mag then
  print_ln('magnification doesn''t match the preamble!');
@.magnification doesn't match@>
max_v:=signed_quad; max_h:=signed_quad;@/
max_s:=get_two_bytes; total_pages:=get_two_bytes;@/
if load_fonts then begin
	@<Process the font definitions of the postamble@>;
	@<Make sure that the end of the file is well-formed@>;
	end;
end;

@ When we get to the present code, the |post_post| command has
just been read.

@<Make sure that the end of the file is well-formed@>=
q:=signed_quad;
if q<>post_loc then
  bad_dvi('bad postamble pointer in byte ',cur_loc-4:1,'!');
@.bad postamble pointer@>
m:=get_byte;
if m<>id_byte then
  bad_dvi('identification in byte ',cur_loc-1:1,' should be ',id_byte:1,'!');
@.identification...should be n@>
k:=cur_loc; m:=223;
while (m=223)and not eof(dvi_file) do m:=get_byte;
if not eof(dvi_file) then
  bad_dvi('signature in byte ',cur_loc-1:1,' should be 223')
@.signature...should be...@>
else if cur_loc<k+4 then
  bad_dvi('not enough signature bytes at end of file (',cur_loc-k:1,')');
@.not enough signature bytes...@>

@ @<Process the font definitions...@>=
repeat k:=get_byte;
if (k>=fnt_def1)and(k<fnt_def1+4) then
  begin p:=first_par(k); define_font(p); k:=nop;
  end;
until k<>nop;
if k<>post_post then
  print_ln('byte ',cur_loc-1:1,' is not postpost!')
@.byte n is not postpost@>

@* Skipping about.
This section provides a number of routines for moving forwards
and backwards in the \.{DVI} file, either ignoring the data
or processing it.

@ First, it is important to note that we normally leave the \.{DVI}
file pointer right after a |bop| command's backpointer, or else we're
|in_postamble|.

@<Process interpage commands and |bop| or |pst|@>=
begin
repeat k:=get_byte;
if (k>=fnt_def1)and(k<fnt_def1+4) then
  begin p:=first_par(k); define_font(p); k:=nop;
  end;
until k<>nop;
if k=post then read_postamble(true)
else if k=bop then begin
	first_pg_pointer:=cur_loc-1; {we'll need this later}
	@<Pass a |bop| command, setting up the |count| array@>;
	end
else bad_dvi('byte ',cur_loc-1:1,' is not bop or post');
@.byte n is not...@>
end

@ Global variable |backpointer| holds a pointer to the page prior
to the current one, while |first_backpointer| is set to point to
the last page in the \.{DVI} file (which we don't know until we
hit the postamble).  The value of |backpointer| can also be
inspected to see whether we're currently in the preamble or
postamble or niether.

@d at_preamble==(backpointer<0)
@d in_postamble==(backpointer=first_backpointer)

@<Glob...@>=
@!backpointer:integer; {the previous |bop| command location}
@!first_backpointer:integer; {backpointer from |post|}
@!first_pg_pointer:integer; {location of first page in DVI file}

@ @<Set init...@>=
backpointer:=-1; first_backpointer:=-223; {so we don't begin |in_postamble|}

@ Here's how we get back to the first page of the \.{DVI} file.

@p procedure to_preamble;
var k:integer;
begin
print(' (to first page) ');
@<Process the preamble@>;
@<Process interpage commands and |bop| or |pst|@>;
page_count:=1;
end;

@ And here's how we get to the last page.  Note that we have to work
our way through the postamble and pick up all the font info there.

@p procedure to_postamble;
var k:integer;
begin
print(' (to end) ');
if total_pages=0 then {we haven't seen the postamble yet}
	@<Find the postamble, working back from the end@>
else begin
	move_to_byte(post_loc);
	k:=get_byte;
	if k<>post then bad_dvi('byte ',cur_loc-1:1,' is not post');
@.byte n is not...@>
	end;
read_postamble(true);
page_count:=total_pages+1;
end;

@ Here's a simple routine that skips over a \.{DVI} page.

@p procedure skip_dvi_page;
label found;
var k:0..255; {command code}
@!down_the_drain:integer; {garbage}
begin
while true do
  begin if eof(dvi_file) then bad_dvi('the DVI file ended prematurely');
@.the DVI file ended prematurely@>
  k:=get_byte;
  p:=first_par(k);
  case k of
  bop: begin @<Pass a |bop| command, setting up the |count| array@>;
    goto found;
    end;
  set_rule,put_rule: down_the_drain:=signed_quad;
  fnt_def1,fnt_def1+1,fnt_def1+2,fnt_def1+3: begin define_font(p);
    end;
  xxx1,xxx1+1,xxx1+2,xxx1+3: while p>0 do
    begin down_the_drain:=get_byte; decr(p);
    end;
  post: begin read_postamble(true); goto found;
    end;
  othercases do_nothing
  endcases;
  end;
found:
end;

@ @<Pass a |bop|...@>=
begin
for k:=0 to 9 do count[k]:=signed_quad;
backpointer:=signed_quad;
end

@ We'll see later how to actually execute a page of \.{DVI} commands.

@p procedure do_dvi_page;
begin
@<Put another page into the internal data structure, flushing
	everything if we're done a cycle@>
end;

@ A routine that's much simpler than |read_DVI| is used to pass over
pages that are not being translated. The |skip_pages| subroutine is
assumed to begin just after the preamble has been read, or just after
a |bop| has been processed. It continues until either finding the
right |bop|, or until running into the preamble or postamble.

@p procedure skip_pages(@!n:integer);
var p,k:integer; {a parameter}
begin
if n<>0 then print(' Skipping ');
if n<0 then @<Skip up to |n| pages backward@>;
if n>0 then @<Skip up to |n| pages forward@>;
if n>0 then print(' (eof) ')
else if n<0 then print(' (bof) ');
end;

@ @<Skip up to |n| pages forward@>=
while (n>0) and (not in_postamble) do begin
	@<Print current page description@>;
	skip_dvi_page;
	incr(page_count);
	decr(n);
	end

@ @<Skip up to |n| pages backward@>=
if random_reading then begin
	if at_preamble then to_postamble;
	while (n<0) and (not at_preamble) do begin
		@<Move backward one page@>;
		@<Print current page description@>;
		incr(n);
		decr(page_count);
		end;
	end
else begin {fake it!}
	n:=page_count+n-1; {how many pages to skip from beginning of file}
	if n<0 then n:=0; {can't wrap around in this version}
	to_preamble; {so |n| is not negative, and we'll skip forward!}
	end

@ The next little routine shows how the backpointers can be followed
to move through a \.{DVI} file in reverse order.

@<Move backward one page@>=
begin
move_to_byte(backpointer); k:=get_byte;
if k<>bop then bad_dvi('byte ',q:1,' is not bop');
@.byte n is not bop@>
@<Pass a |bop|...@>;
end

@ This routine handles doing a number of pages.  If we hit either end
of the \.{DVI} file, it returns even if it hasn't done the requested
number of pages.

@p procedure do_pages(@!n:integer);
var tmp_backpointer,k:integer; {temporary}
begin
if n<>0 then print(' Doing ');
if n>0 then @<Do up to |n| pages forward@>
else @<Do up to |n| pages backward@>;
if n>0 then print(' (eof) ')
else if n<0 then print(' (bof) ');
end;

@ @<Do up to |n| pages forward@>=
while (n>0) and (not in_postamble) do begin
  @<Print current page description@>;
  do_dvi_page;
  @<Process interpage commands and |bop| or |pst|@>;
  decr(n);
  incr(page_count); incr(done_page_count);
  end

@ @<Do up to |n| pages backward@>=
if random_reading then begin
	if at_preamble then to_postamble;
	while (n<0) and (not at_preamble) do begin
		tmp_backpointer:=backpointer;
		@<Move back...@>;
		@<Print current page description@>;
		do_dvi_page;
		incr(n);
		decr(page_count); incr(done_page_count);
		end;
	backpointer:=tmp_backpointer;
	@<Move back...@>;
	end
else print_ln('Sorry, can''t do that')

@ The starting page specification is recorded in two global arrays called
|start_count| and |start_relation|. For example, `\.{1.*.-5}' is represented
by |start_relation[0]=equal|, |start_count[0]=1|, |start_relation[1]=any|,
|start_relation[2]=equal|, |start_count[2]=-5|.
We also set |start_vals=2|, to indicate that count 2 was the last one
mentioned. The other values of |start_count| and |start_relation| are not
important, in this example.

@<Glob...@>=
@!start_count:array[0..9] of integer; {count values to select starting page}
@!start_relation:array[0..9] of relation; {relevence of |start_count| value}
@!start_vals:0..9; {the last count considered significant}
@!count:array[0..9] of integer; {the count values on the current page}

@ The possible values for |start_relation| are:

@<Types...@>=
@!relation=(@!any_relation, @!less_than, @!less_or_equal, @!equal_to,
	@!equal_or_greater, @!greater_than, @!not_equal_to);

@ @<Set option default values@>=
start_vals:=0; start_relation[0]:=any_relation;

@ Here is a simple subroutine that tests if the current page might match
the user-supplied page specification.

@p function start_match:boolean; {does |count| match the spec?}
label done;
var k:0..9;  {loop index}
@!apples, @!oranges: integer;
begin
start_match:=false; {expect the worst}
for k:=0 to start_vals do begin
	apples:=count[k]; oranges:=start_count[k];
	case start_relation[k] of
		any_relation: do_nothing;
		less_than: if not (apples<oranges) then goto done;
		less_or_equal: if not (apples<=oranges) then goto done;
		equal_to: if not (apples=oranges) then goto done;
		equal_or_greater: if not (apples>=oranges) then goto done;
		greater_than: if not (apples>oranges) then goto done;
		not_equal_to: if not (apples<>oranges) then goto done;
		end;
	end;
start_match:=true; {hope for the best}
done:
end;

@ Another option available to the user is to search forwards or
backwards for a page with specified counter values.

@p procedure search_forward;
var p,k:integer; {a parameter}
begin
print(' Skipping ');
if start_match and null_page_spec then skip_dvi_page;
while (not start_match) and (not in_postamble) do begin
	@<Print current page description@>;
	skip_dvi_page;
	incr(page_count);
	end;
if in_postamble then print(' (eof) ');
end;

procedure search_backward;
var p,k:integer; {a parameter}
begin
print(' Skipping ');
if random_reading then begin
	if at_preamble then to_postamble;
	repeat
		@<Move backward one page@>;
		@<Print current page description@>;
		incr(n);
		decr(page_count);
	until start_match or at_preamble;
	end
else print_ln('Sorry, can''t');
end;

@ We can also do the same while processing pages.

@p procedure run_forward;
var p,k:integer; {a parameter}
begin
print(' Doing ');
if start_match and null_page_spec then do_dvi_page;
while (not start_match) and (not in_postamble) do begin
	@<Print current page description@>;
	do_dvi_page;
	@<Process interpage commands and |bop| or |pst|@>;
	incr(page_count); incr(done_page_count);
	end;
if in_postamble then print(' (eof) ');
end;

procedure run_backward;
var p,k:integer; {a parameter}
@!tmp_backpointer:integer; {temporary}
begin
print(' Doing ');
if random_reading then begin
	if at_preamble then to_postamble;
	repeat
		tmp_backpointer:=backpointer;
		@<Move backward one page@>;
		@<Print current page description@>;
		do_dvi_page;
		decr(page_count); incr(done_page_count);
	until start_match or at_preamble;
	backpointer:=tmp_backpointer;
	@<Move back...@>;
	end
else print_ln('Sorry, can''t');
end;

@ The most delicate skipping routine is the one that reads from the
end of the |dvi_file|, looking for the postamble.

@<Find the postamble, working back from the end@>=
begin
n:=dvi_length;
if n<53 then bad_dvi('only ',n:1,' bytes long');
@.only n bytes long@>
nn:=n-4;
repeat if nn=0 then bad_dvi('all 223s');
@.all 223s@>
move_to_byte(nn); k:=get_byte; decr(nn);
until k<>223;
if k<>id_byte then bad_dvi('ID byte is ',k:1);
@.ID byte is wrong@>
move_to_byte(nn-3); q:=signed_quad;
if (q<0)or(q>nn-33) then bad_dvi('post pointer ',q:1,' at byte ',nn-3:1);
@.post pointer is wrong@>
move_to_byte(q); k:=get_byte;
if k<>post then bad_dvi('byte ',q:1,' is not post');
@.byte n is not post@>
post_loc:=q;
end

@ Note that the last steps of the above code saves the location of the
the |post| byte.

@<Glob...@>=
@!post_loc:integer; {byte location where the postamble begins}

@* Setting up internal page descriptions.
Now that we know how to read \.{DVI} files and write \.{APS} files, we're
all set to set up and knock down the internal data structures that represent
the final pages to be output.  The main trick here is that while the \.{DVI}
page may be all mixed up, we want to write an \.{APS} file that never uses
``reverse leading;'' that is, we want to output characters by baseline, from
the top of each page to the bottom.

This code is fairly efficient under the assumption that the \.{DVI} pages
are mostly in order from top to bottom, with occasional large vertical
jumps (to begin a new column, say).  It also assumes that there are not
a very large number of different baselines on each page.

For each baseline, we will create in |mem| a list of instructions on
how to typset the characters and rules on that baseline.  Most of the
entries in such a list will probably be in the range |0..next_low|, in
which case they point to a character segment to be printed.  The
entries generally use sequential, decreasing entried in memory, but an
entry with a value $n$ in the range |-1..-mem_max| means that the list
is continued at location $-n$ in memory.  A value $n$ in the range
|-10000000..-19999999| means that a white space |-n-15000000| units
wide should be output.  A value of |-20000000| or less is used to
encode rules, as seen below.

Each baseline will also have a header record, and these are kept in
a doubly-linked list.

@d next_baseline_loc=0
@d prev_baseline_loc=1
@d vpxl_loc=2
@d hpos_loc=3
@d first_loc=4
@d last_loc=5
@d baseline_length=6
@#
@d next_baseline(#)==mem[#+next_baseline_loc].int
@d prev_baseline(#)==mem[#+prev_baseline_loc].int
@d vpxl(#)==mem[#+vpxl_loc].int
@d hpos(#)==mem[#+hpos_loc].int
@d first(#)==mem[#+first_loc].int
@d last(#)==mem[#+last_loc].int
@#
@d allocate_baseline(#)==begin
	next_high:=next_high-baseline_length;
	check_mem;
	#:=next_high+1;
	end

@<Glob...@>=
@!cur_baseline:mem_loc; {pointer to current baseline record}
@!top_baseline:mem_loc; {pointer to dummy top baseline at $-\infty$}
@!temp_baseline:mem_loc; {temporary pointer for creating a new baseline}
@!new_baseline:mem_loc; {temporary pointer for creating a new baseline}
@#
@!cur_hpos: integer; {quick access temporary for |hpos(cur_baseline)|}
@!new_hpos: integer; {temporary for new value for |cur_hpos|}
@!hadjust: integer; {amount to change |cur_hpos| by}
@#
@!cur_vpxl: integer; {quick access temporary for |vpxl(cur_baseline)|}
@!new_vpxl: integer; {temporary for new value for |cur_vpxl|}
@!cur_vpos: integer; {|cur_vpxl| in \.{DVI} units}
@!new_vpos: integer; {temporary for new value for |cur_vpos|}

@ The baselines on a page are kept in a doubly-linked list, so it is
convenient to have two dummy list entries to guard the ends.

@<Put the starting touches on the internal page description@>=
allocate_baseline(top_baseline); {dummy top baseline}
allocate_baseline(cur_baseline); {dummy bottom baseline, made current}
prev_baseline(cur_baseline):=top_baseline;
next_baseline(top_baseline):=cur_baseline; {link them}
vpxl(top_baseline):=-infinity; {beyond top of page}
vpxl(cur_baseline):=infinity; {beyond bottom of page}
cur_baseline:=top_baseline; {make |top_baseline| current}
cur_vpxl:=-infinity; cur_vpos:=-infinity;
cur_hpos:=0;

@ We have to set up the time-saving global variables when we move to a
new baseline.

@<Complete change of |cur_baseline|@>=
cur_hpos:=hpos(cur_baseline);
cur_vpxl:=new_vpxl; {see below}

@ Before a new baseline becomes current, we have to be carefull to update
the old current one's information.

@<Get ready to change |cur_baseline|@>=
hpos(cur_baseline):=cur_hpos;
last(cur_baseline):=next_high;
decr(next_high); check_mem; {leave a spot for the |last| position in the list}

@ The same thing must also be done after the page has otherwise been completed.

@<Put the finishing touches on the internal page description@>=
@<Get ready to change |cur_baseline|@>

@ If the baseline we're changing to isn't making its first appearance,
then we have to update the location that its |last| field points to,
to make a link in the list of items on the baseline's list.  We make
it point to |next_high|, because that is where we'll start to allocate
the next glyph pointers for the baseline list.

@<Return to an established baseline@>=
mem[last(cur_baseline)].int:=-next_high {put a jump instruction in list}

@ Now we're ready to deal with the code that is called into play when
the current baseline goes out of favor, so we must search for where the
right one, perhaps creating it if it doesn't exist yet.  We assume that
the value for |vpxl| of the baseline we want is in |new_vpxl|.

@<Change baselines@>=
begin
@<Get ready to change |cur_baseline|@>;
if new_vpxl<cur_vpxl then begin
	if 2*new_vpxl<cur_vpxl then cur_baseline:=top_baseline {a heuristic}
	else
		repeat cur_baseline:=prev_baseline(cur_baseline)
		until new_vpxl>vpxl(cur_baseline);
	end; {now |new_vpxl >= vpxl(cur_baseline)|}
while new_vpxl>=vpxl(next_baseline(cur_baseline)) do
	cur_baseline:=next_baseline(cur_baseline);
{now |new_vpxl <  vpxl(next_baseline(cur_baseline)) and
      new_vpxl >= vpxl(cur_baseline)|}
if new_vpxl=vpxl(cur_baseline) then
	@<Return to an established baseline@>
else	@<Insert a new baseline record after |cur_baseline|@>;
@<Complete change of |cur_baseline|@>;
end

@ When we insert a new baseline record, we also make it current.

@<Insert a new baseline record after |cur_baseline|@>=
begin
allocate_baseline(new_baseline);
temp_baseline:=next_baseline(cur_baseline);
next_baseline(new_baseline):=temp_baseline;
prev_baseline(new_baseline):=cur_baseline;
next_baseline(cur_baseline):=new_baseline;
prev_baseline(temp_baseline):=new_baseline;
vpxl(new_baseline):=new_vpxl;
hpos(new_baseline):=0;
first(new_baseline):=next_high;
cur_baseline:=new_baseline;
end

@ Now we have all the tools we need to update the data structure when
the \.{DVI} reading portion of the program wants to put down a
character segment.  It calls this routine, with the segment pointed to
by |cur_sg|, and its location in |h| and |v|. |orig_sg| is usually
the same is |cur_sg|, but in cases where |cur_sg| had to be switched
to point at the default entry segment to accommodate compressed
character segment entries, |orig_sg| contains the original value.

We can't let characters go past the left margin, or our data structure
will get fouled up.  We issue a warning message for any page on which
characters were left off for being too far to the left.

@d pxl_round(#)==round(conv*(#))
@d un_pxl_round(#)==round((#)/conv)

@<Insert current segment at current location into the data structure@>=
new_vpos:=v+sg_y_offset; @<Establish |new_vpos|@>;
new_hpos:=h+sg_x_offset; @<Establish |new_hpos|, but |goto 9997| if illegal@>;
high_int(orig_sg);
cur_hpos:=cur_hpos+sg_pixel_width;
if cur_hpos>gbl_max_right then gbl_max_right:=cur_hpos;
if cur_hpos>paper_width then begin
	incr(right_dropped_chars);
	incr(total_right_dropped_chars);
	if cur_hpos>max_right then begin
    		max_right:=cur_hpos;
		if cur_hpos>gbl_max_right then
			gbl_max_right:=cur_hpos;
		end;
	end;
9997:

@ Note that characters that are past the left edge of the paper are actually
dropped, while characters that go beyond the given paper width are kept track
of but are still output.

@<Establish |new_hpos|...@>=
hadjust:=pxl_round(new_hpos-cur_hpos);
if hadjust<>0 then begin
	if new_hpos<0 then begin
		incr(left_dropped_chars);
		incr(total_left_dropped_chars);
		if new_hpos<max_left then begin
			max_left:=new_hpos;
			if new_hpos<gbl_max_left then
				gbl_max_left:=new_hpos;
			end;
		goto 9997;
		end;
	cur_hpos:=cur_hpos+un_pxl_round(hadjust);
	high_int(-(15000000+hadjust));
	end

@ @<Establish |new_vpos|@>=
if new_vpos<>cur_vpos then begin
	new_vpxl:=pxl_round(new_vpos);
	if new_vpxl<>cur_vpxl then begin
		cur_vpos:=new_vpos;
		@<Change baselines@>;
		end;
	end

@ When we get here, we are to typeset a rule of height |p| and width |q|
with bottom left hand corner at |h|, |v|.  Additional complication is
due to the fact that the \.{APS} can only handle rules as tall as 20 points.

@<Declare functions used by |read_DVI|@>=
procedure got_rule;
label 9997;
var height,@!width,@!part_height,@!part_count:integer;
begin
width:=rule_pixels(q);
height:=rule_pixels(p);
part_count:=0;
repeat
	new_vpos:=v-un_pxl_round(part_count*200); @<Establish |new_vpos|@>;
	new_hpos:=h; @<Establish |new_hpos|...@>;
	cur_hpos:=cur_hpos+un_pxl_round(width);
	if height>200 then part_height:=200
	else part_height:=height;
	high_int(-20000000-part_height-256*width);
	height:=height-200;
	incr(part_count);
until height<=0;
if cur_hpos>paper_width then begin
	incr(right_dropped_chars);
	incr(total_right_dropped_chars);
	if cur_hpos>gbl_max_right then gbl_max_right:=cur_hpos;
	if cur_hpos>max_right then begin
		max_right:=cur_hpos;
		if cur_hpos>gbl_max_right then
			gbl_max_right:=cur_hpos;
		end;
	end;
9997:
end;

@ |do_crop_mark| is a little routine to emit a crop mark at the
specified coordinates.

@<Declare functions used by |read_DVI|@>=
procedure do_crop_mark(@!len,@!thk,@!hpos1,@!vpos1,@!hpos2,@!vpos2:integer);
begin
p:=thk; q:=len; h:=hpos1; v:=vpos1; got_rule; {horizontal line}
p:=len; q:=thk; h:=hpos2; v:=vpos2; got_rule; {vertical line}
end;

@ Here is where we handle the \.{XY} list.  The logic is a little convoluted
in order to provide for the possible odd first sheet due to the \.{F} option.

@<Put another page into the internal data structure, flushing
	everything if we're done a cycle@>=
if not read_DVI then bad_dvi('page ended unexpectedly');
@.page ended unexpectedly@>
if mem[xy_pointer].int=infinity then begin
	@<Put the finishing touches on the internal page description@>;
	write_ICL;
	xy_pointer:=xy_start;
	@<Put the starting touches on the internal page description@>;
	end;

@ If the number of pages doesn't exactly fill an even number of cycles,
we have to remember to finish things of neatly.

@<Clear out any remaining pages@>=
if xy_pointer<>xy_start then begin
	@<Put the finishing touches on the internal page description@>;
	write_ICL;
	end;

@* Dumping out internal page descriptions.
Now that the page has been all put together, we can stroll thruough
the various baselines and output the page.

@<Procedures for writing ICL files@>=
procedure write_ICL;
label done;
var end_glyph:mem_loc; {end of baseline location}
@!cur_glyph: integer; {current glyph code}
@!i,@!j:integer; {temporary}
@!q:integer; {index}
begin
incr(done_cycle_count);
if xy_count<>1 then
  begin
    print('<',done_cycle_count:1,'>');
    update_terminal;
  end;
@<Set |cur_baseline| and |cur_vpxl| for first baseline@>;
@<Start a new APS page@>;
@<Move down to first baseline@>;
new_vpxl:=cur_vpxl;
while new_vpxl<infinity do begin
	@!debug
	print(' Down',new_vpxl-cur_vpxl:1,' ');
	gubed@/
	APS_down(new_vpxl-cur_vpxl);
	cur_vpxl:=new_vpxl;
	APS_out(APS_RB); {move to left margin}
	@<Spit out a baseline worth of stuff@>;
	cur_baseline:=next_baseline(cur_baseline);
	new_vpxl:=vpxl(cur_baseline);
	end;
if bot_space>cur_vpxl then APS_down(bot_space-cur_vpxl);
@<End an APS page@>;
done:
end;

@ We may skip everything, if there's nothing on the page.

@<Set |cur_baseline| and |cur_vpxl| for first baseline@>=
cur_baseline:=next_baseline(top_baseline);
cur_vpxl:=vpxl(cur_baseline);
if cur_vpxl=infinity then goto done;

@ @<Move down to first baseline@>=
if (cur_vpxl>max_top_space) then APS_down(max_top_space)
else if (cur_vpxl<min_top_space) then APS_down(min_top_space)
else APS_down(cur_vpxl);
@!debug
print(' FirstBaseline',cur_vpxl:1,' ');
gubed@/

@ Now we're at the right vertical location; time to do the glyphs on this
line.  If |cur_sg| points to a compressed character segment, then it'll
have to be expanded to 16 words by overlaying it onto the default
settings segment as was done previously.

@<Spit out a baseline worth of stuff@>=
cur_glyph:=first(cur_baseline);
end_glyph:=last(cur_baseline);
while cur_glyph<>end_glyph do begin
	cur_sg:=mem[cur_glyph].int;
        cur_sg_type:=sg_type(cur_sg);
	if cur_sg>0 then begin
                if sg_type(cur_sg)=segtype_short then
                  begin
                    cur_sg:=sg_ptr(cur_sg);
                    @<Move short character segments into the default-settings
			 segment@>;
                  end;
		@<Spit out the character at |cur_sg|@>;
		decr(cur_glyph);
		end
	else begin
		cur_sg:=-cur_sg;
		if cur_sg<=mem_max then cur_glyph:=cur_sg
		else begin
			if cur_sg<20000000 then @<Spit out some white space@>
			else @<Spit out a rule@>;
			decr(cur_glyph);
			end;
		end;
	end;

@ The simple one first.

@<Spit out some white space@>=
begin
@!debug
print(' white',cur_sg-15000000:1);
gubed@/
APS_out(APS_HA); APS_two(cur_sg-15000000);
end

@ The general approach is that we'll keep track of where the \.{APS}
thinks we are, and what font it thinks is in effect, etc., and we'll
send it commands to change those values when necessary.

@<Glob...@>=
@!APS_font:integer; {and the font it thinks we're using}
@!APS_VZ_val,@!APS_HZ_val:integer; {and the size of the font}
@!APS_oblique:boolean; {are we slanting?}
@!APS_slant:integer; {amount of slanting}
@!APS_bits:integer; {special effects}

@ As a new page starts, the \.{APS} forgets everything.

@d undefined_value==@"7FFFFFFF {non two-byte-value}

@<Start a new APS page@>=
APS_font:=undefined_value; APS_oblique:=false; APS_slant:=0; APS_bits:=0;

@ For each character, we have to check that the \.{APS} has the correct
font is selected, and at the correct size, too.

@<Spit out the character at |cur_sg|@>=
begin
if sg_data_ptr=0 then @<Spit out a built-in glyph@>
else begin
	@!debug
	print(' MX ');
	gubed@/
	APS_font:=undefined_value; {BUG in the u5 firmware FIXME???}
	@!zilog
	if ((many_bytes-sg_word_1)<32000) {BUG FIXME ???}
	then @<Spit out a buffer copy instrucion@>
	else
	goliz
		 @<Spit out a glyph from the \.{AMF} file@>;
	end;
end

@ Before telling the APS to typeset a built-in character, we have to
check that the correct font and size and characteristics are in
effect.

If the required |sg_APS_char| is zero, then space over the appropriate
amount instead.  A warning message is printed elsewhere when this happens.

@<Spit out a built-in glyph@>=
begin
@<Check the APS font@>;
@<Check the APS scaling@>;
@<Check the APS slant@>;
@<Check the APS bits@>;
if sg_APS_char<>0 then
  APS_out(sg_APS_char)
else
  begin
    APS_out(APS_HA); APS_two(pxl_round(sg_pixel_width));
  end;
@!debug
print(' C:',sg_APS_char:1,' ');
gubed@/
end

@ This program doesn't know the default size of a font, but that's just
as well because not all Autologic firmware agrees on what it should be.

@<Check the APS font@>=
if APS_font<>sg_APS_font then begin
	APS_font:=sg_APS_font;
	APS_out(APS_CF); APS_two(APS_font);
	@!debug
	print(' F:',sg_APS_font:1,' X',sg_x_magnification:1,
		' Y',sg_y_magnification:1,' ');
	gubed@/
	APS_VZ_val:=undefined_value; APS_HZ_val:=undefined_value;
	end

@ We optimize the output file a little in the common case where the point
size is the same as the set size.
@<Check the APS scaling@>=
if sg_x_magnification<>APS_HZ_val then begin
	APS_HZ_val:=sg_x_magnification;
	if sg_x_magnification=sg_y_magnification then begin
		APS_VZ_val:=APS_HZ_val;
		APS_out(APS_PZ); APS_two(APS_HZ_val);
		@!debug
		print(' PZ:',APS_HZ_val:1,' ');
		gubed
		end
	else begin
		APS_out(APS_HZ); APS_two(APS_HZ_val);
		@!debug
		print(' HZ:',APS_HZ_val:1,' ');
		gubed
		if APS_VZ_val<>sg_y_magnification then begin
			APS_VZ_val:=sg_y_magnification;
			APS_out(APS_VZ); APS_two(APS_VZ_val);
			@!debug
			print(' VZ:',APS_VZ_val:1,' ');
			gubed
			end;
		end;
	end
else if APS_VZ_val<>sg_y_magnification then begin
	APS_VZ_val:=sg_y_magnification;
	APS_out(APS_VZ); APS_two(APS_VZ_val);
	@!debug
	print(' VZ:',APS_VZ_val:1,' ');
	gubed
	end;

@ Rather than having a `current amount of slant', the APS either
turns slanting on or off, and if it's on, the direction is controled
by another parameter.

@<Check the APS slant@>=
if sg_APS_slant<>0 then begin
	if APS_slant<>sg_APS_slant then begin
		APS_slant:=sg_APS_slant;
		APS_out(APS_OA); APS_two(APS_slant);
		end;
	if not APS_oblique then begin
		APS_oblique:=true; APS_out(APS_OM);
		end;
	end
else if APS_oblique then begin
	APS_oblique:=false; APS_out(APS_NM);
	end

@ Here's where we handle special effects such as reverse video, rotation
and wrong-reading.

@<Check the APS bits@>=
if sg_APS_bits<>APS_bits then begin
	{BUG FIXME not yet implemented}
	end

@ To tell the \.{APS} to typeset a character that isn't built in,
we have to set up a `matrix in data stream' command.

@<Spit out a glyph from the \.{AMF} file@>=
begin
@!zilog
sg_word_1:=many_bytes;
goliz
APS_out(APS_MX); APS_two(1);
APS_two(sg_x_magnification); APS_two(sg_y_magnification);
APS_two(sg_data_length+4); APS_two(sg_data_length+2);
j:=sg_data_ptr;
for i:=0 to sg_data_length-1 do
	case i mod 4 of
	0: begin m:=mem[j]; incr(j);
	   APS_out(m.qqqq.b0); end;
	1: APS_out(m.qqqq.b1);
	2: APS_out(m.qqqq.b2);
	3: APS_out(m.qqqq.b3);
	end;
for i:=1 to 8 do APS_out(0); {BUG FIXME is this necessary?}
end

@ @<Spit out a buffer copy instrucion@>=
begin
@!zilog
silent_APS_out(223);
copy_length:=sg_data_length+18; {BUG FIXME SHOULD BE 11 or so, must be even}
if copy_length<256 then	silent_APS_out(copy_length div 2)
else begin
	silent_APS_out(((copy_length div 2) mod 128) + 128);
	silent_APS_out(copy_length div 256);
	end;
silent_APS_two(sg_word_1 mod 32768);
sg_word_1:=many_bytes;
many_bytes:=many_bytes+copy_length;
goliz
end

@ @<Set init...@>=
@!zilog
many_bytes:=32768; {makes no characters known in circular buffer}
goliz

@ Now for rules.

If the |ancient_APS| flag has been set then be careful to always switch to
the range one permafont before emitting the rules.  If different fonts
and point sizes are active when rules are emitted on some of the older
machines then the positioning of the rules is slightly off.  The problem
is corrected here by always activating the permafont before doing any
rules.  That way the environment is always the same.

@<Spit out a rule@>=
begin
if (ancient_APS) and (APS_font<>0) then
  begin
    APS_font:=0;  {the permafont always has number zero}
    APS_out(APS_CF);  APS_two(0);
    APS_out(APS_PZ);  APS_two(100);
    APS_VZ_val:=undefined_value;
    APS_HZ_val:=undefined_value;
  end;
cur_sg:=cur_sg-20000000;
rule_dimen:=cur_sg div 256; perhaps(APS_BH,rule_dimen,APS_BH_val); {width}
rule_dimen:=cur_sg mod 256; perhaps(APS_BV,rule_dimen,APS_BV_val); {height}
APS_out(APS_XB); {do it}
@!debug
print(' Rule X',APS_BH_val:1,' Y',APS_BV_val:1,' ');
gubed@/
end

@ We need two variables to remember what size rules the \.{APS} thinks
we are using.

@<Glob...@>=
@!APS_BH_val:integer; {horizontal rule dimension}
@!APS_BV_val:integer; {vertical rule dimension}
@!rule_dimen: integer; {temporary rule dimension}

@ The ICL manual doesn't mention it, but it seems safe to assume that
the rule values get reset at the beginning of a page.  Since a `white
rule' will never make it to the output phase, a value of zero here
will never match.

@<Start a new APS page@>=
APS_BV_val:=0; APS_BH_val:=0;

@* Interactive page specification dialog.
Pages are specified by giving a sequence of 1 to 10 numbers or
asterisks separated by dots. For example, the specification `\.{1.*.-5}'
can be used to refer to a page output by \TeX\ when $\.{\\count0}=1$
and $\.{\\count2}=-5$. (Recall that |bop| commands in a \.{DVI} file
are followed by ten `count' values.)  An asterisk matches any number,
so the `\.*' in `\.{1.*.-5}' means that \.{\\count1} is ignored when
specifying a page to search for.  Returns |false| on error.

@p function get_page_spec:boolean;
label done;
var res:boolean; @!cur_relation: relation;
begin
if buffer[buf_ptr]="%" then begin
	res:=true; null_page_spec:=true; goto done; end
else null_page_spec:=false; {special hack to emulate EMACS}
start_vals:=0; start_relation[0]:=any_relation; res:=false; {assume the worst}
k:=0;
repeat
	@<Scan a relation@>;
	skip_spaces;
	if (k<9) then begin
		if buffer[buf_ptr]="." then begin
			incr(buf_ptr); skip_spaces;
			end;
		if buffer[buf_ptr]="%" then start_vals:=k
		else incr(k);
		end
	else if buffer[buf_ptr]="%" then start_vals:=k
	else goto done;
until start_vals=k;
res:=true; {but hope for the best}
done:
get_page_spec:=res;
if not res then print_ln('Illegal page search specification');
end;

@ Tedious.
@<Scan a relation@>=
if buffer[buf_ptr]="*" then begin
	cur_relation:=any_relation; incr(buf_ptr);
	end
else begin
	if buffer[buf_ptr]="<" then begin
		incr(buf_ptr);
		if buffer[buf_ptr]="=" then begin
			incr(buf_ptr); cur_relation:=less_or_equal;
			end
		else if buffer[buf_ptr]=">" then begin
			incr(buf_ptr); cur_relation:=not_equal_to;
			end
		else cur_relation:=less_than;
		end
	else if buffer[buf_ptr]=">" then begin
		incr(buf_ptr);
		if buffer[buf_ptr]="=" then begin
			incr(buf_ptr); cur_relation:=equal_or_greater;
			end
		else cur_relation:=greater_than;
		end
	else if buffer[buf_ptr]="=" then begin
		incr(buf_ptr);
		if buffer[buf_ptr]="<" then begin
			incr(buf_ptr); cur_relation:=less_or_equal;
			end
		else if buffer[buf_ptr]=">" then begin
			incr(buf_ptr); cur_relation:=equal_or_greater;
			end
		else cur_relation:=equal_to;
		end
	else cur_relation:=equal_to; {implied}
	start_count[k]:=get_integer;
	if got_error then goto done;
	end;
start_relation[k]:=cur_relation

@ We'll see later that there is a subtle meaning to giving a null
page specification:  A search command will normally find the current
page, if it matches an explicit page specification argument, but
a null argument is guarenteed not to find the current page.  This
is a feature, according to the following reasoning.  In an indirect
page specification file, the user would like to be able to say
"s 5", "y", "s 6", "y" without worrying about whether pages five
and six are sequential.  On the other hand, the interactive user
wants to be able to say `this isn't the page six I wanted, let
me see the next one' without having to type the page specification
again. (This theory comes from the EMACS search commands.)

@<Glob...@>=
@!null_page_spec:boolean;

@ If the user goes into interactive mode, s/he is given the opportunity
to move about in the \.{DVI} file, doing pages forward and back, perhaps
multiple times.

@p procedure read_page_file; forward; {mutual recursion possible}
procedure do_page_line;
begin
buf_ptr:=0; skip_spaces;
cmd:=buffer[buf_ptr]; if cmd>"@@" then skip_letters
else if cmd<>"%" then incr(buf_ptr);
while (buffer[buf_ptr]="=") or (buffer[buf_ptr]=":") or (buffer[buf_ptr]=" ")
	do incr(buf_ptr); {skip over delimiters}
lower_case(cmd);
case cmd of
	"%": do_nothing; {comment or no command given}
	"@@": read_page_file;
	"?": @<Give help for page prompt@>;
	"y": @<Do some pages@>;
	"n": @<Skip some pages@>;
	"g": @<Do goto command@>;
	"s": @<Search forward@>;
	"r": @<Search backward@>;
	"u": @<Run forward@>;
	"d": @<Run backward@>;
	"e": more_interaction:=false;
	othercases print_ln('Illegal page option: ',xchr[cmd]);
	endcases;
end;

@ Everything keeps going while there's |more_interaction|.

@<Glob...@>=
@!more_interaction: boolean; {does the user want to specify more pages?}

@ @<Set init...@>=
more_interaction:=true;

@ Just like |read_option_file|.

@p procedure read_page_file;
var opt_file: text_file; {file of options}
@!k:0..name_length; {option file name length}
@!cur_len:integer; {needed for error messages}
begin
@<Open the option file@>;
repeat
	input_ln(opt_file);
	if buf_len>0 then do_page_line; {empty lines are comments}
until (eof(opt_file)) or (not more_interaction);
@<Close the option file@>;
end;

@ Just like |option_dialog|.

@p procedure page_dialog;
var k:integer;
begin
if random_reading then
	@<Skip ahead and read the postamble@>;
repeat
	@<Print |page_count| and perhaps |total_pages|@>;
	@<Print current page description@>;
	print(': '); update_terminal;
	input_term_ln;
	if buf_len>0 then do_page_line;
until not more_interaction;
end;

@ Here is some code to skip to the postamble and read a few values.
This enables |page_dialog| to work a little better. Normally the
postamble doesn't get read until it gets bumped into.  Assume we
are positioned at the first DVI page initially, and reposition to
there after reading the postamble.

@<Skip ahead and read the postamble@>=
begin
@<Find the postamble, working back from the end@>;
read_postamble(false);
move_to_byte(first_pg_pointer+1);
@<Pass a |bop| command, setting up the |count| array@>;
end;

@ If we've seen the postamble, then we can tell how many pages were
in the \.{DVI} file, otherwise we can only report the page number
we're on.

@<Print |page_count| and perhaps |total_pages|@>=
print('(',page_count:1);
if total_pages>0 then print('/',total_pages:1);
print(') ')

@ @<Do some pages@>=
begin pages:=get_integer;
if got_error then pages:=1;
do_pages(pages);
if in_postamble then to_preamble;
print_nl;
end

@ @<Skip some pages@>=
begin pages:=get_integer;
if got_error then pages:=1;
skip_pages(pages);
if in_postamble then to_preamble;
print_nl;
end

@ @<Do goto...@>=
begin
pages:=get_integer;
if pages<1 then got_error:=true;
if (total_pages>0) and (pages>total_pages) then got_error:=true;
if not got_error then begin
	if pages*2<page_count then to_preamble
	else if random_reading and
	 (total_pages>0) and ((total_pages-pages)<(pages-page_count))
		then to_postamble;
	skip_pages(pages-page_count);
	end;
if in_postamble then to_preamble;
print_nl;
end

@ @<Search forward@>=
begin
if get_page_spec then search_forward;
if in_postamble then begin print(' Not found'); to_preamble; end;
print_nl;
end

@ @<Search backward@>=
begin
if get_page_spec then search_backward;
if not start_match then begin print(' Not found'); end;
print_nl;
end

@ @<Run forward@>=
begin
if get_page_spec then run_forward;
if in_postamble then begin print(' Not found'); to_preamble; end;
print_nl;
end

@ @<Run backward@>=
begin
if get_page_spec then run_backward;
if at_preamble then begin print(' Not found'); end;
print_nl;
end

@ @<Give help for page prompt@>=
begin
print_ln('Options available: (all can be abbreviated to one character)');
print_ln(' yes             => yes, do this page');
print_ln(' no              => no, don''t do this page');
print_ln(' y 9             => yes, do next 9 pages');
print_ln(' n10             => no, skip next 10 pages');
print_ln(' n-3             => no, move back 3 pages');
if random_reading then
print_ln(' y -9            => yes, plus previous 8 pages');
print_ln(' goto 3          => no, and go to absolute page 3');
print_ln(' search 9        => no, and move forward to DVI page [9]');
print_ln(' s               => no, and repeat last search');
if random_reading then
print_ln(' reverse 1.2     => no, and move backward to DVI page [1.2]');
if random_reading then
print_ln(' downto * 22     => yes, down until DVI page [*.22]');
print_ln(' upto <=33 * >44 => yes, up until DVI page [<=33.*.>44]');
print_ln(' @@file           => read page commands from file');
print_ln(' exit            => exit (don''t do any more pages)');
end

@ @<Print current page description@>=
begin
print('[');
for k:=0 to start_vals do
  begin print(count[k]:1);
  if k<start_vals then print('.');
  end;
print(']');
update_terminal;
end

@* The main program.
Now we are ready to put it all together. This is where \.{DVIAPS} starts,
and where it ends.

@p begin initialize; {get all variables initialized}
read_availability;
@<Process the preamble@>;
@<Print the preamble id@>;
@<Make the first...@>;
option_dialog; {set up all the options}
@<Do computations that depend on user options@>;
@<Process interpage commands...@>;
if in_postamble then begin print('No pages in DVI file!'); goto final_end; end;
@<Start up the |APS_file|@>;
@<Set |xy_pointer| depending on |xy_first|@>;
@<Put the starting touches on the internal page description@>; {first sheet}
if max_pages<>0 then do_pages(max_pages)
else page_dialog;
@<Clear out any remaining pages@>;
print_nl;
@<Finish off the |APS_file|@>;
@<Display option settings@>;
@<Print job summary statistics@>;
final_end:end.

@ The main program needs a few global variables in order to do its work.

@<Glob...@>=
@!k,@!n,@!nn,@!pp,@!qq:integer; {general purpose registers}
@!id1_string, @!id2_string: packed array [-3..512] of ASCII_code;
@!id1_length,@!long_id1_length,@!id2_length,@!long_id2_length: integer;
@!pages: integer; {how many pages to do}

@* System-dependent changes.
This section should be replaced, if necessary, by changes to the program
that are necessary to make \.{DVIAPS} work at a particular installation.
It is usually best to design your change file so that all changes to
previous sections preserve the section numbering; then everybody's version
will be consistent with the printed program. More extensive changes,
which introduce new sections, can be inserted here; then only the index
itself will get a new section number.
@↑system dependencies@>

@* Index.
Pointers to error messages appear here together with the section numbers
where each ident\-i\-fier is used.